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ABSTRACT 


''  This  note  describes  the  use  of  the  DE3ADE  program  version  presently 
running  on  the  CDC  6600  through  the  FPO-1  computer  terminal.  A  tri-moor 
cable  array  structure  is  given  here  as  an  example  to  illustrate  the 

procedures  in  using  this  program.  The  original  manual  on  which  this 

/ 

note  is  based  was  prepared  by  R.  A.  Skop  and  J.  Mark  of  Naval  Research 
Laboratory,  Washington,  D.  C. 


The  program  calculates  the  current  -  induced  static  deflections  of 
structural  cable  arrays.  Attached  to  this  note  are  results  of  test  runs 
made  for  the  Linear  Chair  candidate  configurations.  This  was  designed  to 
serve  as  an  check  for  the  on  going  Linear  Chair  analysis  contract  with 
DTNSRDC  using  the  DSSM  program.  ^  ' '  r  *  ^ 
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1.  Note  of  the  program 


Usefulness 


Method 


Assumptions 


Capabilities 


Limitations 


0  computing  current  -  induced  static  deflections 
of  structural  cable  arrays. 

0  Most  general  (Ref.  1) 

0  Experimentally  validated  (Ref.  3) 


0  Use  Method  of  imaginary  reactions  (Ref.  A)  and 
method  of  successive  approximations  for  treating 
position  and  conf iguration  dependent  forces  (Ref.  5) 


0  The  hydrodynamic  force  on  the  devices  and  cables 
is  the  normal  drag. 

0  The  current  is  undirectional  and  horizontal  (with 
certain  modification  it  could  accept  arbitrary 
current  field  with  variable  directions). 


0  arbitrarily  configured  arrays  of  up  to  22  cables 
0  variable  cable  materials 
0  any  number  of  discrete  devices 


0  Cable  segments  cannot  be  on  the  ocean  floor, 

0  Dimensions  of  discrete  device  must  be  small 

compared  to  overall  array  dimensions  (not  valid 
for  moored  submerged  submarine.) 

0  All  parts  of  the  array  must  be  submerged  (unless 
the  surfaced  device  coordinates  are  specified) 
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.  Number  the  cables  consecutively  from  one  to  the 
total  number  of  cables  in  the  array.  Each  cable 
so  designed  must  have  uniform  properties  (weight, 
diameter,  drag  coefficient,  and  constitutive  relation). 

A  change  in  property  also  requires  a  change  in  cable  ! 
number. 

.  Number  the  junctions  consecutively  from  one  to  the 
total  number  of  junctions  in  the  array.  A  junction 
may  designate  an  anchor,  the  intersection  point  of 
two  or  more  cables,  or  the  free  end  of  a  cable. 

.  Use  a  fixed,  right-hand  cartesian  coordinate  system 
to  describe  the  configuration  of  the  array  in  the 
space.  The  origin  of  the  system  can  be  arbitrarily 
located.  E  axis  is  defined  parallel  to  the  direction 
of  gravity  and  increasing  upward.  In  this  example  the 
origin  is  placed  at  the  geometric  center  of  the  equilateral 
triangle  formed  by  the  three  anchors  in  the  sea  floor  plan. 

d.  Tabulate  the  anchor  coordinates  (Table  1.) 


Table  1 


Junction  No. 

|  Anchor  coordinate 

S 

of  anchor 

X  (ft)  I 

!  Y  (ft) 

1  a  (ft) 

Reduce  the  array  to  statically  determinate  array 
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structure.  The  cuts  are  made  in  the  following  manner: 

1.  Number  of  cuts  =  number  of  cables  -h  number  of 

anchors  -  number  of  junctions 

2.  Cuts  must  be  made  at  end  points  of  cables  (adja¬ 
cent  to  junctions) . 

3.  The  first  group  of  cuts  must  be  made  so  as  to 
release  all  but  one  cable  from  an  anchor. 

A.  The  remaining  required  cuts  are  made  within  the 
array  and  must  be  located  so  as  not  to  break 
the  array  into  separated  parts. 

5.  Assign  each  new  cut  a  consecutive  junction  number 
continuing  from  the  last-used  junction  number. 

6.  Tabulate  the  junction  number 
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Table  2 

Cut  number 

Original  Junction 

New  Junction 

Number  at  cut 

Number  at  cut 

1 

1 

5 

2  ! 

3 

6 

i 

7.  Define  the  directions  of  increasing  arc  length, (s), 
along  each  cable  by  using  a  topological  tree  diagram 
for  the  reduced  array  structure  (see  sketch).  The 
directions  are  indicated  by  the  arrowheads  in  the 
climbing  'up'  direction  from  root  to  top. 

8.  Following  the  directions  given  in  step  7  tabulate  the  junction 
number  of  the  startin ;  (s»0)  and  ending  (s=L)  points  for  each 
cable  (Table  3). 
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Table  3 


Cable  number 


Junction  number 
at  s=0 


Junction  number 
at  s=L 


The  starting  and  ending  points  of  each  cable  can  be  identified  by 
following  the  direction  of  'climbing  up*  the  topological  tree  diagram, 
s  is  the  arc  length  measured  from  starting  junction.  L  is  the  length  of 
each  cable. 

Current  description  ^ 

C.urre**t 

The  standard  current  field  is  defined  as 

V  -  V(z)  (CosG  i  +  Sin©  j)  Li— I  ► 

where  v(z)-  current  value  at  z. 

0  =  current  angle  with  respect  to  x  axis 

/x  A  - / 

[ ,  ]  -  unit  vectors  in  the  x  and  y  azes  / _  t 

The  program  generates  the  velocity  profile  by  connecting  each  current 
data  point  by  a  series  of  straight  lines.  The  current  below  the  minimum 
z  value  is  considered  the  same  as  V(z.minimum) .  Using  the  current  profile 
given  in  Figure  2  the  input  current  data  can  be  tabulated  (Table  4.) 

Table  4 


?.  Coordinate  (ft) 


V  (?,)  (Knots) 


l 


!  ... 


■  •.  -  a 


I  m 


I.  .J f , 

.•  '  *  A'  -V 


.•  >**','*■  •  . 

-  *  w  •  „  '  ,  ' 

•  .  • 

.  *  ■  ^  •  *  »  *  *  • 

L  -  JKL 


.53 


4.  Program  Structure 

In  addition  to  the  main  program  ’DESADE’  there  are  8  subroutines 
and  7  functions.  These  are  described  below: 


Subroutines 


INPUT 


PHSOUT 


STROUT 


TAPOUT 


ERROR 


RPOLY 


SWITCH 


START 


Functions 


TCAB(M,K) 
EXCAB (M,K) 
EFORCE  (I) 


CFORCE  (I ,M,N) 


SPACE  (I) 


TANC  (I) 


VELOC  (I,P  SAPCE) 


Reads  all  data  and  identifies  errors  in  data,  deck 
structure,  and  array  representation. 

Generates  information  concerning  the  physical  character¬ 
istics  of  the  structural  cable  array. 

Generates  the  array  structural  output. 

Generates  the  tape  or  cards  giving  the  locations  of  the 
indexed  devices . 

Generates  error  message  when  the  accuracy  required  for 
the  array  equilibrium  calculation  could  not  been  obtained 

Finds  real  roots  of  polynomial  equations  for  use  in 
evaluating  maximum  cable  displacements  and  tension 
extreme  . 

Switches  input  data. 

Calculates  the  initial  guesses  . 


Purpose 


Calculates  the  tension  at  node  M  of  Cable  K  , 
Calculates  (1  +  strain)  at  node  M  of  Cable  K  . 

Calculates  the  hydrodynamic  drag  force  on  each 
device  in  direction  I. 

Calculates  the  force/length  in  direction  I  at  node 
M  on  Cable  N. 

Calculates  the  location  in  space  of  any  point  on  the 
array  . 

Calculates  the  unit  tangent  to  a  cable  at  any  point  , 


Specifies  the  I  component  of  the  current  field 
at  an  arbitrary  point  in  space,  PSPACE  (I) 


I  .  •  L  »  1  •»  "I 


6.  Input  Coding 


(l)  I/O  logical  unit  number  card 

Column  1  4-j  8j  •  6|  *4l  32. 1  4-0 1  481  5-fel  £ 

Ncard  [Card  |Nread  [^write  l^tape  llopt.  (Blank  fMopt.'  (K-opt. 

NCard  =  card  number,  (14),  From  -  999  to  9999,  used  to  sequence  the 
data  cards 

Card  =-'LUN,  (A4) ,  used  to  catalog  each  data  card 

Nread  =  5,  (18),  reader  unit  number 

Nwrite  =  6,  (18),  printer  unit  number 

Ntape  =  2,  (18),  service  tape  unit  number 

lopt.  =  0,  (18),  Input  option  using  source  deck 

Mopt.  =  2  or  0,(18),  Output  option  to  printer 

Kopt.  =  3  or  blank,  (18),  Output  tape  unit  number 
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(2)  number  card  of  junctions 

U  41  81 

|Ncard  (Card  |Njun.  J 

Card  =  Njun.,  (A4) ,  card  name 

Njun.  =  number  of  junction  in  original  Array,  (18) 
(See  Figure  1) ,  2  -  NJun  -  44 


(3)  Anchor  location  cards  (one  for  each  anchor) 

iwi~wv>vi 

Card  =  ~ANC,  (A4) 

Njun.  =  Junction  number  of  anchor  (original  array) 
1  £  NJun  *  44  ;  (18) 
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X  =  anchor  X  -  coordinate  (ft.)»  (F8.0) 

Y  =  anchor  Y  -  coordinate  (ft.)»  <F8.0) 

Z  =  anchor  Z  -  coordinate  (ft.),  (F8.0) 


Refer  to  Table  1. 


»  1 


(4)  Cut  data  cards  (one  for  each  cut) 

|i  4.1  81  l£>  I  24 


(Ncard  |Card  |Njurij{jew  |N  un,01d  I 
Card  =  « IR,  (A4) 

Njun  New  =  New  junction  number  at  cut,  (18) 
Njun.oid  =  Orginial  junction  number  at  cut,  (18) 

1  _  ^Jun,01d  -  44 
Refer  to  Table  2. 


(5)  Cable  cards  (one  for  each  cable)  .  , 

|»car<i‘|catd3|Nc'iNJun.‘lNjun.’‘l«c"’|c<.c4S|d  'V  |c’1h  |><elc. 


jT  •  .  j- 

L.J 


Card  =  -  CAB,  (M) 

Nc  =  cable  number;  (18),  1  -  Nc  s  22 

Njun,s=o  =  Junction  number  at  s=o,  (18),  1  -  N  -  44 

Njun,s=L  =  Junction  number  at  s=L,  (18),  1  -  N  -  44 

Wc  =  cable  unit  weight  in  sea  water  (lb/ft),  (F8.0) 
(+)  if  positively  buoyant 
(+)  if  negatively  buoyant 


t  I 


l  _i 


Cdc  =  cable  normal  drag  coeff icient ; (F8. 0) ( (based  on  cable  diameter) 
d  =  cable  diameter,  (inO^FS.O) 

L  =  cable  unstressed  length  (ft),  (F8.0) 


C  =  cable  rigidity  (lb);(F8.0) 

(T/C)k  =  0.  T  =  tension,  6=  Strain,  k  =  constant 

k  =  constant  in  cable  constitutive  relation ( (F5.0) 

Nele.  =  number  of  finite  elements  in  cable  calculation , (13) , 
0<  N  -  50 


(6)  Device  on  cable  cards  (one  for  each  device) 

It  4  j  a  |  Ifej  32!  40J  4sl  71I 

|Ncard  |Card8JNc  I  Itype  |  Index  JWd  |Cj)  |A.  |l  |  Sd  j 


Card  =  DCAB,  (A4) 


Nr  =  number  of  cable  to  which  device  is  attached,  (18) 


1  -  N  -  22 


Itype  =  devi-ce  type,  (18),  1  or  3  for  in-line  elongated  device 
(longitudinal  axis  aligns  with  cable  axis) ,  2  or  4  for 
other  free  devices  or  for  divices  inside  the  cable. 

Ilndex  =  Device  index  if  type  1  or  2,  (18)  1  -  I  -  1000,  Type  1  and 

2  must  be  indexed  consecutively  from  one  to  the  total  number 
of  type  1  and  2  devices  in  the  array, 

Wd  =  device  weight  in  sea  water  (lb.),  (F8.0) 

(+)  if  positively  buoyant 
(-)  if  negatively  buoyant 
cDd  =  device  drag  coefficient,  (F8.0) 

(based  on  frontal  area  or  diameter) (blank  if  device  is  inside 
the  cable) 

2 

A.  =  Frontal  area  of  device  for  type  2  or  4  (ft  );(F8.0) 


ft  m 


I  P 


11 


or  diameter  of  device  for  type  1  or  3 , (in)^ (F8.0) 

1  =  device  length  (if  type  1  or  3) j (f t)^ (F8.0) 

Sd  =  Unstressed  distance  of  device  from  s=o  junction  of  the 
cable^ (ft) t  (F8.0) . 

(7)  Device  on  junction  cards  (one  for  each  device) 

I,  4I  8I  lal  24I  31  I  -wl  48 1  56 1 

»Ncard  *^ar<^  lNJun  l^type  '^dex  *Wd  l^°d  I  A.  I 

Card  =  DJNC,  (A4) 

Njun  =  number  of  junction  to  which  device  is  attached,  (18) 

1  -  N  -  44 

Xtype  =  Device  type  (2  or  4) ,  (18) 

Idex  =  Device  index  if  type  2,  (18) 

1  -  I  -  1000  (indexed  consecutively  from  one  to  the  total 
number  of  type  1  and  2  devices  in  the  array. 

Wj  =  Device  weight  in  sea  water  (lb.)  (F8.0) 

(+)  if  positively  buoyant 
(-)  if  negatively  buoyant 

Cq  =  Device  drag  coefficient  based  on  frontal  area  (F8.0) 

A.  =  device  frontal  area  (ft^),  (F8.0) 

<8i  Water  density  card 

l**card  !cardS|  Pi  | 

Card  =->DEN ,  (A4) 

P(  =  sea  water  density,  (slug/  ft^),  (F8.0) 


2 


(9)  End  of  data  card 

l^card  (card8 | 

Card  =oEOD,  (A4) 

(.10)  Flag  card  to  specify  current  data 

l^card  I  Card  jl0pt. current  j 
Card  =  NDAT,  (A4) 

I-opt.  current  =  Current  option  =  1  standard 

-  2  nonstandard  (use  modified  program) 

(18) 

(11)  Accuracy  card  (following  the  1st  NDAT  card) 


Card  =  COMP,  (A4) 

E-  accuracy  specified  *.ft)  ,  (F8.0) 

To  insure  the  calculated  coordinates  of  every  point  in  the 
array  are  within  +  E  of  their  exact  values.  The  obtainable 
t  is  limited  by  the  computer  capacity  and  by  the  largest 
linear  dimension  in  the  array. 

L  -  10m  n+^  where  m  =  common  lo^fithm  of  the  largest  linear 
dimension,  n  =  number  of  significant  figures  carried  in  single 
precision  (e.g.  n  =  8,  L  =  25,000  ft,  £  -  0.1  ft.) 
t  =  1  ft.  was  used  in  the  test  runs. 

Q2)  Current  cards  (one  for  each  point) 

Ii  ^1  a|  i&)  24| 

"card  lCard  I*  lV<«  I 


Card  =  a  VEL,  (A4) 


Z  =  Z  -  coordinate  of  input  point;(ft),  F8.0) 

V(Z)  =  Velocity  at  input  pointy (knots) ,  (F8.0) 

Up  to  25  VEL  cards  are  permitted.  At  least  on  input  point  must 
be  below  or  equal  the  minimum  Z  coordinate  of  the  anchors. 

(13)  Current  direction  card 
lNcard4|card8|6o  ^0  Je/) 

Card  =  ~ANG,  (A4) 

0Q  =  initial  current  angle  (deg.),  (F8.0) 

=  increment  in  current  angle  (deg.  >0^  (F8.) 

=  final  current  angle  (deg.  -  ©  o)>(F8.0) 

(14)  End  of  data  card 

Card  =  r-  EOD,  (A4) 


(151  Termination  card 
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Card 


‘card 
Card  =  EOP ,  (A4) 


Output  Parameters 

The  outprints  are  self-explanatory  and  consist  of: 

a.  Array  descriptive  output: 
o  anchor  locations 

o  cuts  information 
o  cable  properties 
o  device  properties 
o  current  field 

b.  Structural  output: 

o  current  condition 

o  cable  forces  and  angles  at  each  anchor 
o  location  of  the  array  junctions 

o  displacement  of  these  junctions  from  the  no-current  coordinates 
o  cable  forces  and  angles  at  each  junction 

o  maximum  and  minimum  tension  and  their  location  for  each  cable 

o  location  and  displacement  of  devices  from  the  no-current 
coordinates 

o  tension  at  devices. 

A  sample  output  for  the  tri-moor  is  .given  in  Appendix  B-2. 


8  .  File  Status 


DESADEK 


DESADW 


DSDLG0K 

G0DESAD 


G0DSAD 


G0DSW 


ATASP 


AT  AGP  1 


ATAGP8 


ATABGP 


DAT  ASS 


DESCRIPTION 


Source  program 


Source  program  modified  to  accept 
variable  current  directions. 

Compiled  program  on  NCi> 

Procedure  file  to  run  by  Scope 
system  (Compile,  catalog  LG0  file 
and  run . ) 

Procedure  file  to  run  by  Scope 
system  (run  LG0  file.) 

Procedure  file  to  run  by  Scope 
system  (Compile  and  run.) 

Bench  data  from  Ref.  1  > 

Data  file  for  single  post  near 

Data  file  for  goal  post  moor 

Data  file  for  goal  post  w/eight 
additonal  buoys  on  each  post. 

Data  file  for  braced  goal  post 
post  moor. 

Data  file  for  sea  spider  moor. 

Data  file  for  single  post 
single  buoy  moor. 

Data  file  for  DOOMS  moor: 


*TAPE  NAME:  KW2233  Created  on  8-3-77 


»  m 


STATUS 


ON  TAPE  ON  DISK 


-V-  .■« 

jVyVyv' 

t  wr  \ 


v'  v'  *. 
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9.  Computer  Requirements  and  Cost 
a.  Requirements 

DESADE  is  a  Fortran  IV  program  and  is  ready  for  CDC  Fortran  IV 
compilers.  Memory  requirements  are  approximately  30,000  words  in  a 
single  precision.  Access  to  one,  two  or  three  magnetic  tape  units, 
depending  on  the  I/O  options  chosen,  is  required  by  the  program. 

b.  Cost 

Computer  costs  for  the  test  runs  are  shown  in  the  following  table 


ARRAY 

i  I/O  time  j 

Execution  time*  i 

total*  SBU 

CONFIGURATION 

(SEC) 

(SEC)  | 

UNITS  (SEC) 

Single  post 
Sea  spider 
Goal  Post 
Braced  Goal  Post 


110/30 ' s 
36/39' s 
208/10's 


ESTIMATE** 

V- 

TOTAL  COST 

„  •*.  i'  *" 

(?) 

i  :m 

*  CDC  Computer  charge  unit 

**  Based  on  over  night  rate  (priority  2)  plus  terminal  connecting  charge 
and  I/O  charge.  Current  rates  are  (July,  1977)  : 


Pirority  |  (Overnight) 


Rate  (?) 


(Daytime) 


Terminal  connection: 
Terminal  I/O: 


$9/hr . 

$.20/1000  character 


Note  the  compilation  time  (~  4.5  sec)  was  saved  for  each  run  through 
the  use  of  a  compi  led  binary  file  (DESLGO) 


f  PC  I 


L'.'W  V  '.1*', 

I  .ML 


10.  Run  Steps 
(1)  Log  in 


KB  < I H J 1 1 


«  .>  *.-^r  -r,-, 


CHAR  ,  ?<--370TG,  CAOLECOt-iP  ' 


(2)  Prepare  data  file 


a.  Either  create  your  own  file  (see  next  section  on  how 
to  establish  data  file). 

b.  Or  edit  existing  data  files  of  similar  array  configuration. 

c.  A  sample  of  data  file  is  shown  on  page  2.0  • 


(3j  Prepare  run  procedure  file 

a.  Edit  existing  file  to  desired  condition  (job  priority, 
data  file  name,  etc.) 

b.  A  sample  of  run  procedure  file  is  shown  on  page  J9  . 


I  .  . 


!  M 


(4)  Submit  job 

a.  See  example  on  page  19 


(5)  Check  for  job  status 

a.  See  example  on  page  <9. 

16)  Get  day  file  when  job  is  ready  for  output. 

a .  See  example  on  page  (  9  . 

(7)  Print  output 

a.  See  example  on  page  I  9- 

*  The  underlined  characters  arc  user's  entry.  Consult  with  FPO-li 
to  update  these  entries. 


*  m 


G  £  f  f<1<yi  prac-^du/e  P  i  |  gn  i  Tc  Sui<  N?t<1 


r<f  4y-tL<.~lf  I  t-  ) 


c;  •., :: >' 


■  ,_■ ,.,  i...  i .  •  '...• . —  •  ■ 


!.;c: 


in  Pfd 


5  k  b  wi  ■  4"  "-J  *■ 


^ubmit»god^Ad>st-ecz>t 

1 4  » A 2  -  >-■  /  <Ah. U w Q K 


Gel  Dav./  pile  wlui  J"ok  • 


.  Tn 

5  i-to  r- 


/}  s>;.cy.,’.e!  j  oh  iiAtw-c- 


QSTATUS^ 

r  >■  IT!  •/ 


■  ';  f  ‘ :  -  * 


-r.r'  J+^u-5 


frrMIL.  7  i-iGW  f-ii-  l  •'■ 


•  L'  V 


U't>L.  Aeoc&^v  K 


ii  t‘eo.c/y  G<-  p 


QFETCH .  AEC.CBSK^M.'L," 


f  i  c  f-  r!  Ay  r.  !»' 


T?  .i  ",  /  ! 

t  r  .  •  t  >  v  -t , j  -•  f 


r  itT- 

*  The  underlined  characters  art  user's  entries. 


References 


1.  R.  A.  Skop,  and  J.  Mark,  'A  Fortran  IV  program  for  computing  the 
static  deflections  of  structural  cable  arrays’,  NRL  Report  7640, 

August  1973. 

2.  N.  D.  Albertsen,  'A  survey  of  techniques  for  the  analysis  and  design 
of  submerged  mooring  systems' (CEL  Report  815,  Aug.  1974. 

3.  T.  R.  Kretschmer,  G.A.  Edgerton,  and  N.  D.  Albertsen,  'Seafloor 
construction  experiment,  SEACON  II  -  an  instrumented  Tri-moor  for 
evaluating  undersea  cable  structure  tehcnology’  CEL  Report  R848, 

Dec.  1976. 

4.  R.  A.  Skop,  and  G.  J.  O'Hara,  'The  static  equilibrium  configuration 
of  cable  arrays  by  use  of  the  method  of  imaginary  reaction  s'  NRL  report 
6819,  Feb.  1969. 

5.  R.  A.  Skop,  and  R.  E.  Kaplan,  'The  static  configuration  of  a  tri- 
moored,  subsurface,  buoy  -  cable  array  acted  on  by  current  -  induced 
forces  ',  NRL  Report  6894,  May  1969. 

6.  R.  L.  Webster,  'DSSM  computer  program' ^E  Report  1976. 


APPENDIX  A 


Results  of  Test  Runs 

The  test  runs  were  made  for  the  Linear  Chair  candidate  configurations. 
The  results  have  been  used  to  compare  the  calculations  made  by  DTNSRDC 
using  the  DSSM  computer  program  (Ref.  6).  In  the  following  tables 
the  DTNSRDC' s  results  are  enclosed  by  prentheses.  Good  agreement  exists 
in  most  of  the  cases.  The  computer  costs  are  comparable.  However  the 
finite  element  representation  for  each  cable  member  is  much  finer  in 
the  test  run  calculations  than  those  made  by  DTNSRDC. 
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CM  CUT  MADE 


IMtaWVMjl 


PROGRAM  DESADE(lMPi/r, OUTPUT,  TAP62,  TAPE  3  ,  TAPS  5 -  INPUT,  TAPE  6  »  OUTPUT} 
C 

C  A  FORTRAN  IV  PROGRAM  FOR  COMPUTING  THE  STATIC  DEFLECTIONS 
C  OF  STRUCTURAL  CABLE  ARRAYS 
C 

C  BY  RICHARD  A.  SKOP  AND  JAMES  MARK •  OCEAN  TECHNOLOGY  DIVISION* 

C  NAVAL  RESEARCH  LABORATORY*  WASHINGTON.  D*  C. 

C 

COMMON  /Bl/  FEJUNC  .  IR.DELTAl .DEL T A . I RS . TF JUNC  . L . ES . FCAB .RCAB . JUMP 
1PJUNCS.PCAB  .PCABE.PC ABO.RCAbO. THETA. PJUNCO 
COMMON  /B2/  NCAB  *NNODE .ER JUNC  *1RJUNC*DATA.DATN»H  »P JUNC  * 
1CDCAB.DCA6.FATE.NANC  .  AN JUNC *  I Rt AD . IPRNT . I  NT APE .OUT APE  *  I T 1ME . I FLG . 
20FLG.N 1R. THETAS *T HE T Ac. COMPD. THE TAu.N JUNC .RHO. TEST . 
3NVSEG.2VEL.VELZ. PIP  >EC I CAt .eXPC Ab »Z JUNC  *L JUNC. PATH. ICAe* IVOPT  * 
4WCAB  .IDEV.ICHECK.NDEV.NDATC 

DIMENSION  FEJUNC ( 3 .44 ) . I R 1 3 .44 )  . 1 RS ( 3  .4  4 )  .TFJUNC ( 3.44 )  .PJUNCOI3.4 

II 

DIMENSION  FCAB ( 3  *51  .22 )  .  RCAB ( 3 . 5 1 . 22 ) .PJUNCS (3.44) » PCAB ( 3  *  5 1 . 22 ) 
DIMENSION  PCABt (3.51.22) . PC ABO ( 3 . 5 1 . 22 ) . RCABO (3.51.22) 

DIMENSION  NNODEt  22  I  .ER JUNC (44) • I R JUNC (44 )  .DATA ( 10) .DATNl 10)  .HI  22 ) 
DIMENSION  p JUNC ( 3.44 )  .CDCABl 22 ) » DCAB (22) . AN JUNC ( 44 ) .TEST! 14) 
DIMENSION  Z VlL ( 25 )  «VELZ(25) .EC  I  CAB (22) .EXPCABI22) .2 JUNC (22) 
DIMENSION  L JUNC (22 1  .PATH! 22 ) . I  CAB l 22 ) »  W  C  A  b ( 2  2 ) . I  DC VI 1000) 
DIMENSION  I  CHECK ( 44 ) 

DIMENSION  DATAT (2150.10) 

equivalence  < da tatii). fejunc (l) i 

INTEGER  OUTAPE.2JUNC . ER JUNC . AN JUNC .OFLG 
INTEGER  PATH 
REAL  1R  » IRS 
C 

C  CALL  INPUT  TO  READ  DATA  AND  IDENTIFY  ERRORS 
C 

I T IME= 1 

1000  CALL  INPUT 
C 

C  CHECK.  TO  SEE  IF  ANY  ERRORS  IN  DATA 
C 

IFIFATE.NE.O. )  GO  TO  10000 
C 

C  GET  HERE  IF  NO  ERRORS  —  PRINT  OUT  PHYSICAL  CHARACTERISTICS  OF  ARRAY 
C 

WRITE! IPRNT. 1001) 

1001  FORMAT!///. 5X.18HNO  ERRORS  DETECTED) 

CALL  phsout 


K.MUL  T 


MULTIPLIER  FOR  CHANGING  CURRENT  ANGLE  THETA 


KMULT=0 

JUMP=0 - NO  CURRENT  JUMP=1 - CURRENT 


JUMP=0 


C 

c  GET  HERE  TO  CALCULATE  FORCES  AND  IF  SUCCESSIVE  APPROXIMATION  ROUTINE 
0  NOT  SATISFIED  —  ZERO  FORCES 


DES001 

DES002 

0ES003 

DESC04 

DES005 

DES006 

DESQ07 

DES008 

•DES009 

DES010 

DES011 

DES012 

DES013 

DES014 

DES015 

4DES016 

DES017 

DES01B 

DES019 

DES020 

DES021 

DES022 

DES023 

DES024 

DES025 

DES026 

DES027 

DES028 

DES029 

DES030 

DES031 

DES032 

DES033 

DESQ34 

DES035 

DES036 

DES037 

DES038 

DES039 

DES040 

DES041 

DES042 

DES043 

DES044 

DES045 

DES046 

DES047 

DES048 

DES049 

DES050 

DES051 

DES052 

DES053 

DES054 

DES055 


y.l  M*.. 

*•  '  *  V 


J*  1  m  M*  •  * 


I  M 


*„■  ■.  •-  %  %  , 


r  m 


n  a  Ann  nnn 
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R.A.  SHOP  AND  J.  MARK 


2011  DO  2012  J=  1 *N JUNC 
00  2012  1=1,3 

2012  Ft JUNC ( 1 , J ) =0* 

DO  2013  N=1,NCAB 
INNN=NN0DE(N) 

DO  2013  M= I  *  I NNN 
DO  2013  1=1*3 

2013  FCABI I *M,N)=0. 

C 

C  PICK  UP  DISCRETE  UEVICt  DATA  FROM  TEMPORARY  STORAGE  TAPE  AND 
C  CALCULATE  DtVICE  FOKCtS  —  DJNC  FORCES  ARE  STORED  IN  FEJUNC  — 

C  DCAb  FORCES  IN  FCAo  —  EFOKCt(I)  IS  KOUTINt  FOR  CALCULATING 
C  DtVICE  FORCtS  IN  DIRECTION  I 
C 

201S  READ! INTAPE, 1>  ( DAT A t K )  ,K  =  1 , 10 ) 

1  FORMAT  <F4,0»A4»8E15«8) 

IF (DATA12) »EQ,TEST 13) )  GO  TO  2017 
IF(DATA(2).EQ.TtST(4))  GO  TO  2019 
IF (DATAI2) .EO.TtST ( 9) )  GO  TO  2021 
GO  TO  2013 

2017  K  =  DAT A ( 3 ) 

DO  2010  J= 1 , 3 
I=J 

2018  FEJUNC ( I »K) =FEJUNC ( I  ,K)+EFOKCE( I  1 
GO  TO  2013 

2019  K  =  DATA  <  3 ) 

M=  DATA (10) /HOC)  +  1 

DO  2020  J= 1 , 3 

I=J 

2020  FC Ab ( l *M  *  K I  =  FCAbl  I  ,M ,  K  I  +  EFORCtll) 

GO. TO  2015 

GET  HERE  AT  END  OF  TAPE 

2021  REWIND  INTAPt 

NOW  CALCULATE  THt  FORCE/LtNGTfi  IN  DIRECTION  I  AT  NODE  M  ON  CABLE  N 
CFOKCE ( I >M*N J  IS  ROUTINE  FOR  DOING  THIS  —  INTEGRATE  bY  TKAPE20IDAL 
RULt  OVER  SEGMENT  TO  GET  TOTAL  FORCE  AND  ADD  TO  DCAb  FORCES 

DO  2 022  J= 1  ,NC Ab 
K  =  J 

I NNN  =  NNODE  (  K  )  - 1 
DO  2022  MM= 1,1 NNN 
M=MM 

DO  2022  11=1,3 
1=  l  I 

202  2  FCAbl  I  *  M  *  K  I  =  (CFOKCE I  I  *M*K) +CF ORCt I  I  ,M+1 , K ) I *H ( Kl /2 .  +  FCAB ( I ,M »K > 
C 

C  ALL  FORCtS  ARE  NOW  CALCULATED  AND  EOUILIbRIUM  CAN  BE  DETERMINED 

c  leap  =  i  first  time  through  imaginary  reaction  routine 
c  LEAP  =  2  any  other  time 
c  skip  this  SUCTION  if  NO  IR'S 
c 

IF (NIR.EO.O)  GO  TO  2031 
IF( JUMP. CO. 0)  CALL  START 
leap=i 
c 


DES056  -  ■ 

DES057  - 

DES058  ■ 

DES05V 

DES060 

DES061 

DES062 

DES063 

DES064 

DES065 

DES066 

DES067 

DES068 

DES069 

DES070 

DES071 

OES072 

DES073 

DES074 

DES075 

0ES07S 

DES077 

DES078 

DES079 

DES080 

DES081 

DES082 

DES083 

DES084 

DES085 

DES086 

DES087 

DES088 

DES089 

DES090 

DES091 

DES092 

DES093 

DES0V4 

DES095 

DES096 

DES097 

DES098 

DES099 

DES100 

DES101 

DES102 

DES103 

DES104 

CES105 

DES106 

DES107 

DES108 

DES10V 

DES1 10 

DES111 

DES1  12 

DES1  13 

DES1  14 


tyV'.XWlfo- 
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c  INITIALIZE  DELT A 

DES115 

C 

DES116 

DELTA=DELTAI 

DES117 

C 

DES118 

c  6E  T 

HERE  TO  INITIALIZE  TOTAL  FOkCES  AT  THE  JUNCTIONS.  TFJUNC*  AND 

DES119 

C  IF  THE  IMAGINARY  RtACTiON  1 TtRAT ION  NOT  SATISFIED  —  ALSO  IF  NO 

IR»S 

DES120 

C 

DES121 

2031 

DO  2032  J  =  1 .NJUNC 

DES122 

DO  2032  1=1.3 

DES123 

2032 

TFJUNC ( I , J )  =  FLJUNC ( I . J  I 

DES124 

C 

DES125 

C  ADD 

APPROPRIATE  REACTIONS  TO  TFJUNC  —  SKIP  THIS  SECTION  IF  NO 

IR'S 

DES126 

C 

DES127 

IFINIR.EQ.0I  GO  TO  2036 

DES128 

DO  2035  J=1 .NJUNC 

DES129 

DO  2035  K=1.NIR 

DES130 

IF  (  I  J.EQ.  I  RJUNC  ( K)  )  .OR.  I J.EO.tR JUNC  (  K  )  )  )  GO  TO  2033 

DES131 

GO  TO  2035 

DES132 

203  3 

DO  2034  1=1.3 

DES133 

2034 

TFJUNC ( I ♦ J )  =  TFJUNC I  I  »  J  )  +  IR(l.J) 

DES134 

2035 

CONTINUE 

DES135 

C 

DES136 

C  TFJUNC  IS  NOW  DETERMINED  AND  THE  REACTIVE  FORCES  IN  THE  ARRAY. 

RCAB  » 

DES137 

C  CAN 

BE  CALCULATED  bY  SUMMING  FRuM  THE  FREE  ENDS  TO  THE  FIXED  ANCHOR 

DES138 

C 

DES139 

2036 

DO  2047  N=l.NCAb 

DES140 

INDEX=  NCAB+l-N 

DES141 

K  =  PATHl INDEX) 

DES142 

INNN=NN0DE(K) 

DES143 

INLJ=LJUNCIK) 

DES144 

DO  2041  1=1.3 

DES145 

2041 

RCABI  I  .  INNN.K) = TFJUNC! I . INLJ) 

DES146 

DO  2044  L  =  1  .NCAb 

DES147 

IF ILJUNCIK) .EU.ZJUNC I  L ) )  GO  TO  2042 

DES148 

GO  TO  2044 

DES14V 

204  2 

DO  2043  1=1.3 

DES150 

2043 

RCABI  I  .  INNN.K)  =RCAti( 1  .INNN.KI+RCAbl I » 1  *  L ) 

DES151 

2044 

CONTINUE 

DES152 

DO  2046  MM=1.INNN 

DES153 

M= INNN+I-MM 

DES154 

IFIM.EO.l)  GO  TO  2047 

DES155 

DO  2045  1=1.3 

DES156 

2045 

RCABI  I  .M-l ,K) 'RCABI I .M.K1+  FCAul I .M-l.K) 

DES157 

2046 

CONT  INUE 

DES158 

2047 

CONTINUE 

DE  SI  59 

C 

DES160 

C  ALL 

REACTIVE  FORCES  ARE  NOW  DETERMINED  AND  THE  CONFIGURATION  OF 

THE 

DES161 

C  array.  PC Ab  AND  PJUNC .  CAN  DE  FOUND  bY  INTEGRATING  FROM  THE  FIXED 

DES162 

C  ANCHOR  TO  THE  FREE  ENDS  —  INTEGRATION  BY  THE  TRAPEZOIDAL  RULE 

IS 

DES163 

C  AGAIN  USED 

DES164 

C 

DES165 

DO  2054  N= 1 .NCAB 

DES166 

X=PATH(N) 

DES167 

I NLN  =  L JUNC IK) 

DES168 

I NNN=NNOOE I K ) 

DES169 

I NZ J  =  ZJUNC I K ) 

DES170 

DO  2031  1=1.3 

DES171 

2051 

PC AB 1  I  .  1  ,K ) =PJUNC ( I . INZJ) 

DE  S 1 72 

DO  2052  MM=2*INNN 

DES173 

n n n  nnnn  nnn  non  non  non  non  nnnn 
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M=MM 

DO  2052  11=1*3 
1-  I  I 

2052  PCA0(  I  .M.K) =PCAB<  I  »M— 1  «K )  +  (  uXCAB  (  M- 1  »K)  *RC  AB  t  I  .M-l  .K  )  /  TCAB  t  M-l  .K  ) 
H-EXCAb(M.K)*RCAB(  I  *M*K ) / T CAb  (M  »K )  ) *H(K) 22. 

DO  2053  1=1*3 

2053  P  JUNC ( 1  * INLN ) =PCAB  (  I  .  INNN.K) 

2054  CONTINUE 

ARRAY  CONFIGURATION  NOW  DETERMINED  —  CHECK  TO  SEE  IF  IT  SATISFIES 
GEOMETRIC  CONSTRAINTS  —  SKIP  THIS  SECTION  IF  NO  IR»S 

IFINIR.EQ.O)  GO  TO  2071 

CALCULATE  ERROR  E 

E2  =  0. 

DO  2061  N=1 *NIR 
KEN=ERJUNC ( N I 
K  IN=  I  RJU.NC  (  N  ) 

DO  2061  1=1*3 

2061  E2  =  E2+ (  PJUNCI I *KEN )  -  PJUNC(I*KINI  1**2 
E  =  SuRT  <E2) 

COMPARE  ERROR  TO  ACCURACY  REQUIREMENTS 
IFIE.LE.C0MPD/10. )  GO  TO  2071 
GET  HERE  IF  GEOMETRIC  CONSTRAINTS  NOT  SATISFIED 
GO  TO  (2062.2065) .LEAP 

GET  HERE  FIRST  TIME  THROUGH  IMAGINARY  REACTION  ROUTINE 

2062  LEAP=2 

STORE  SUCCESSFUL  POSITIONS  AND  RcACT IONS 

2063  ES=E 
DO  2064  N= 1 *N I R 
KEN =ER JUNC ( N 1 
K  IN= I RJUNC ( N ) 

DO  2064  1=1*3 
P JUNCS ( I .KEN )=P JUNC ( I *KEN ) 

PJUNCS ( I .KIN) =P JUNC ( I .KIN) 

2064  IRS( I »KIN)=IR( I .KIN) 

GO  TO  2066 

GET  HERE  ANY  OTHER  TIME  THROUGH  IMAGINARY  REACTION  ROUTINE 
SEE  IF  ITERATION  SUCCESSFUL 

2065  IF(E.LT.ES)  GO  TO  2063 

REDUCE  DELTA  IF  NOT  SUCCESSFUL  INTERAT ION 

DELTA=DELTA/2. 

C 

C  CALCULATE  NEW  IMAGINARY  AND  EQUILIBRATING  REACTIONS  AND  GO  BACK  TO 
C  RECALCULATE  ARRAY  EQUILIBRIUM 


DES174  .  B 
DES175  '  ■ 
DES17&  .  B 
DES177  B 
DES173V  I 

DES1 79  •  1 
DES180- 
DES18I 
DES182  - 
DES183  v 
DES184  v 
DES185 
DES186^ 
DES 1 87-*?/: 
DES18B 
DES189 
DES190 
DES191 
DES192 
DES193  4? 
DES194  Ms 
DES195  -5. 
DES196-4 
DES197  # 
DES198-'i: 
DES199  «• 
DES200 
DES201  •: 
DES202  ® 
DES203  r' 
DES204  -r 
DES205  - 
DES206 
DES207 
DES208 
DES209  - 
DES210 
DES211  - 
DES212 
DES213 
DES214 
DES215 
DES216 
DES217 
DES218 
DES219 
DES220 
DES221 
DES222 
DES223 
DES224 
DES225 
DES226 
DES227 
DES228 
DES229 
DES230 
DES231 
DES232 
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2066  DO  2067  N-1.N1R 
KEN=ERJUNCtN) 

DO  2067  1=1.3 

2067  IK (  1  »KEN )  =0. 

DO  2066  N= 1  »N  I K 
KtN=EKJUNC(N) 

K  IN=  IR JUNC ( N ) 

DO  2068  1=1,3 

IK(  I  »K  IN)  =  1  RS<  I  »KIN  )  +0ELTA* (PJUACS  (  1  »KEN )-P JUNCS  ( i »KlN ) ) /ES 
206  8  IR(  1  ,KtN)=IR( I  »KtN>-lRC I ,K1N) 

CHECK  CHANGES  1 N  W.GINARY  REACTIONS 

DO  2070  N=1»NIK 
K  1N  = IRJUNC ( N } 

DO  2070  1=1,3 

I F I  I R ( I ,KIN> ,N£. IKS( 1 »KlN) )  GO  TO  2031 
20 io  continue 
no  changes  —  tii-iE  to  ouiT 

C«LL  EKaOR 
GO  TO  10000 

GET  FlERE  II-  ACCURACY  KcUU I KlKENTS  SATISFIED  OK  NO  I  J. »6 

OUTPUT  tOU  iL  I  UK  I  Ui'i  IT  NO  LUKRc.NI  —  i;‘  CuKKt-iNi*  ;  lKii  CFioCiC  tO  c 

IF  ACCURACY  RcOU  1 KEMcNT  SaTISF-.i_u  oY  ‘■jCCtSS  1  Vc  ..PPAOaIiIA  i  ICNa 


2071  JUN  =  JUf'iP+1 

GO  TO  (2072 ,2^76)  ,Jofi 

2072  IF  (  (OFLG.EU.O)  .UK.  (OFLo.cl.2)  I  >.«.■.  STaGUI 
I  F  (  ( OF  LG  •  LO  •  1 )  «OK  •  (  OF  lC  •  to  •  2  I  1  CAL'.  lAPOui 
IF(OFLG.EO.l)  GO  TO  2100 

IF(JUM.Nt.l)  GO  TO  2100 
DO  2200  N=1»NCAd 
INNN=NNOuh (N) 

DO  2200  f  <=  1  ,  IiViN 
UU  22o0  1=1,3 
PCAoO  l  i  ,lvl  »N  )  =PC  AU  (  I 

2200  RCAtlO  (  1  »'a  ,  N  )  =RC  At>  (  I  *  M  t  fi  ) 

DO  22ul  N=1»NJUNC 

DO  2201  1=1,3 

2201  PJUNCOl 1 ,N)=PJUNC( i ,M 

aPPLY  CUKKti\T  IF  K^uUlKcj 

2 loO  IF (  IVOPT.cQ.O)  GO  TO  VYVV 
JUMP= 1 

T MET  A  =  Ti  it.  T  Au  +  KMUL  T  * Tr  -  T  a$ 

IF  (  TnlTa.GT  • TmcTac I  uO  TO  V  v  V  V 
KFiUL  T  =Ki'.ULT  + 1 

SIOkE  tXIbTlrlG  COiiF  1  oOKmI  ion  rills  ,Hnr,l  Sun  PUi\PubEb 

2073  DO  2o/4  M=1,NCAu 
IN.\N  =  NNOUc  (n> 

DO  2u74  (•'.=  1,1  NNK 
DO  2»74  1=1,3 

20  t‘i  PCaUL  (  i  ,r.  »(>.  )  =  PC/'.o  (  I  .  ,n  ) 


DES233 

DES234 

DES235 

DES236 

DES237 

DES238 

UES239 

DES240 

DES241 

DES242 

DES243 

0ES244 

Dtb245 

DEo246 

ucs247 

DES246 

DtS249 

DES260 

D£b2Sl 

Dto252 

UEb2t»3 

Dtb2s4 

Dt623i> 

DEo2&6 

DES2b7 

0£b26U 

D.ta2S9 
DEb26u 
Dtb261 
Dto262 
DE6263 
Dfcs264 
DES26S 
Des266 
Dts267 
DES268 
Dto26V 
DES270 
Dtb271 
DES272 
DES273 
Dtb274 
Uto276 
Dto276 
DL6277 
0£b2 Yo 
D£s27y 
DES280 
CE6281 
DEo2«2 
Des283 
Dtb2  84 
CEb26:> 
DEs28b 
DEb267 
Dko26o 
Dtb289 
DEb2Vu 
uto2y 1 
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RECALCULATE.  FORCcS 
GO  TO  2011 

GET  HtRh  IF  CUKRtixT  —  oUCCti-ii  v 2  aFPI.G/vIi-  s  •  ION  ACCvKAC  i 


2075  DO  2^ 77  N=1.NCAJ _ 

DO  20  /7  M=1  >  INNn 

U“G. 

DO  2076  1=1,3 

2076  Cl=U+  ( PCAoE  ( 1  ,V-.\‘-PCAw(  1  •  •  :  \<  :  »*2 


XMNR  =  NN06E (N) 


IF  NOT  ACCURATt  STOKfc  CONF1C-..R*  7  itN  AND  RCCACCl/LA.  e  FORCED 

I F  (  SORT  ( U ) • GT •  COi-iPD )  GO  10  2‘>7? 

2077  CONTINUE 
C 

C  GtT  HLRt  IF  POSITION  ACCURATE  AND  UuiPul  PGoliiON 
C 

GO  TO  2072 
C 

C  GO  BACK.  FOR  MORE  DATA 
C 

9999  GO  TO  1000 
100U0  CONTINUE 

WR1 Tt ( 1 PRNT  *  10001 ) 
lOOol  FORMAT (1H1) 

END 


DES292 

DEa293 

DES294 

0t&295 

Uto296 

DEo2V7 

wuo298 

DES299 

U1j3uu 

DES301 

Dtd3u2 

DEo3u3 

Dta3u4 

DEo3u5 

UE;>3u6 

DEo3u7 

DEo3ub 

Dto3u9 

DE*>31u 

DEo311 

uto3 12 


DE6313  > 

DE&314  -,V 
DEs315 
DEo316  * 


Ot^317 


Dt^318 


l>t^.319 
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SUBROUTINE  INPUT 


THIS  ROUTINE  READS  ALL  DATA  AND  IDENTIFIES  ERRORS  IN 
DATA.  DECK  STRUCTURE,  AND  ARRAY  REPRESENTATION 

COMMON  /Bl/  FE JUNC .IR.DLLTAI.DlLTA.1HS.TF  JUNC  .E.ES.FCAB.RCAB .JUMP  » 
1PJUNCS.PCAB .PCAbE, PC ABO. RCAbO. THETA, PJUNCO 
COMMON  /B2/  NCAB.NNODL.ERJUNC. I RJUNC .DATA ,UATN ,H , P JUNC * 

1CDCAB .DCAfa .FATE  »NANC » AN JUNC » I  RE AD » I PRNT  .  I  NT APE .OUT APE , I T IME » IFLG, 
20FLG.NI R .THETAS, T HE TAE.COMPD.THlTAL.N JUNC .RHC.TEST  « 
3NVSEG.ZVEL.VELZ.PIP  »EC ICAB .EXPC AB .2 JUNC .LJUNC , PATH . ICAB.IVOPT » 
4WCAB , IDEV , I  CHECK  »NDEV .MDATC 

DIMENSION  F  E JUNC (3.44) »IR(3»44) ,1  RSI  3 ,44) « TF JUNC ( 3 *44  I  , PJUNCO (3. 44 

1) 

DIMENSION  FCAB 13.51 .22) »RCAb I  3 , SI , 22 ) «P JUNCS I  3  «4M »PCAb(3»51 .22) 
DIMENSION  PCABE ( 3  »  SI .22 ) ,PC«bO< 3 ,51 .22 ) .RCABOI 3  » 5 1 ,22) 

DIMENSION  NNODE I  22  I » ERJUNC ( 44 ) » I RJUNC 144) .DATA ( 10) .DATNl 10) .HI  22) 
DIMENSION  PJUNC I  3 .44 ) »CDC AB I  22 ) .DCABI22)  .AN JUNC 144 )  , TEST  I  14 ) 
DIMENSION  ZVEL 125)  »VELZI25)»ECICAbl22)  . EXPC Ab I  22 ) , Z JUNC 122 ) 
DIMENSION  LJUNC 122) .PATH  I  22 ) ,1CAB( 22)  .WCABI22) .IDEVI 1000) 

DIMENSION  I  CHECK  1 44 ) 

DIMENSION  DATAT 12150.10) 

DIMENSION  1  TEST  I  14 ) 

EOU I  VALENCE  IUATATI 1 ) .FtJUNCI 1 )  ) 

EQUIVALENCE  I  I  TEST  I  1 ) » TEST  1 1 ) > 

INTEGER  OUT APE »Z JUNC .ERJUNC .AN JUNC ,UFLG 
INTEGER  PATH 
REAL  IK. IRS 

THIS  IS  THE  BEGINNING  OF  THE  INPUT  SECTION 
INITIALIZE  ALL  CONSTANTS.  FLAGS,  AKKAYS.  AND  COUNTERS 

IF  I  ITIME.NE.l)  GO  TO  99 9 
1  TEST  1 1 ) =4H  IR 
I  TEST  I  2 ) =4H  ANC 
I  TEST  I  3 ) =4H0JNC 
ITESTI4) =4HDC AO 
I  TEST  I  5 ) =  4H  CAB 
I  TEST  I  6 ) =4H  UEN 
1  TEST ( 7 ) =4HC0MP 
I  TEST  18) =4H  ANG 
I  TEST  I  9 ) =4H  EOD 
ITESTI 10)  =  4HNJNC 
ITESTI 11 >=4H  VEL 
ITESTI12)=4HNDAT 
I  TEST  113) =4H  LUN 
1  TEST ( 14 ) =4H  EOP 
PIP=3. 141 59265/ 180. 

I  FEOD=0 
NDATC=0 
KFLG=0 

DO  1000  1=1.1000 

1000  I OEV I  I ) =0 

DO  1001  1=1,44 

1001  I  CHECK  I  I ) =0 

DO  1002  1=1,22 

1002  ICAB I  I ) =0 
NANC=0 


INP001 
INP002 
INP003 
INP004 
1NP005 
INP006 
1NP007 
INP008 
INP009 
INP010 
1NP011 
INP012 
INP013 
INP014 
1NP015 
INP016 
1NP017 
INP018 
INP019 
INP020 
IMP021 
INP022 
INP023 
I NP024 
INP025 
1NP026 
INP027 
INP028 
INP029 
INP030 
INP031 
INP032 
INP033 
INP034 
INP035 
INP036 
INP037 
INP038 
INP039 
INP040 
INP041 
INP042 
INP043 
INP044 
INP045 
INP046 
INP047 
INP048 
INP049 
INP050 
INP051 
INP052 
INP053 
INP054 
INP055 
INP056 
INP057 
1NP058 
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IFRHO=0 
IF JNC=0 
N  I  R  =  0 
IROW=I 
999  FATE=0. 

C 

C  CHECK  LOGICAL  UNITS 
C 

IF!  IT1ME.GT.1)  GO  TO  1003 
I T IME=2 

READ  1004. (DATA! I) .1=1.10) 

1004  FORMAT  <F4.0»A4,8F8.0,F5.0» 13) 

IFIDATAI2) .NL.TtSTI 13 ) !  GO  TO  9018 
1PRNT=DATAC4J 
C 

C  GENERATE  ERROR  MESSAGE  HEADER 
C 

998  WRITE! IPRNT. 9100)  NDATC 

9100  FORMAT ( 1H1 .46HERK0KS  IN  PARAMETRIC  STUDY  SOURCE  DECK  NUMBER  .12.// 
1  12X  »4hCARD  »  3X .4HCARD  »6X  »  SHUTHtR/ lh  »4X  .4HT YPt .4X.3HNO. .3X.4HTYPE. 
23X.11H1 NFORMAT I ON  ) 

IF ( IFEOD.EO.O)  GO  TO  13 
IF!  IFEOD.NE.O)  GO  TO  12701 
C 

C  READ  ONE  INPUT  RECORD  INTO  DATA  ARRAY 
C 

1003  CONTINUE 

IF! IFLG.EO.O)  READ! 1READ. 1004)  ( DA T A ( I ) . I = 1 . 1 0 ) .EX , N SEG 
IF { IFLG.EG.l )  READ! IREAU. 1104)  ( DAT A ( I ) . I = 1 . 1 0 ) . EX » NSEG 
1104  FORMAT IF4.0 .A4.8E13.6 ,/E12.3 . 13 ) 

C 

C  TYPE  AND  BRANCH 
C 

IF!  IFEOD.EO.O)  60  TO  1006 

IF!!0ATA!2).EQ.TESTI12)) .OR. I DATA  t  2J.EO.TEST !14) ) )  GO  TO  1006 
GO  TO  9018 
1006  DO  1006  1=1.14 

I F 1  DATA (2) .EO.TEST ! 1 ) )  GO  TO  I  1,2, 3.4.3, 6, 9018,9016.9, 10, 9018. 

1  12  .9018,14)  . I 
1003  CONTINUE 
C 

C  GET  HERE  IF  CARD  UNIDENTIFIABLE 
C 

GO  TO  9000 
C 

C  GET  HERE  IF  IR  CARD  READ 
C 

1  I F ( DATA ( 3 ) -DATA ! 4 ) )  101,9001.101 

101  DO  102  1=3,4 

IF!  (DATA ( I ) .LT .  1 . ) .OR . ( DATA  I  I ) .GT .44. ) >  GO  TO  9001 

102  CONTINUE 
C 

C  GET  He. RE  IF  DATA  OK 
C  COUNT  IR  AND  STORE  DATA 
C 

N I R=N I R+l 

I R JUNC 1 N I R ) =DA  T  A ( 3 ) 

ER JUNC ( N I R ) =DAT  A ( 4 ) 

DO  103  N= 1 , N IR 


INP059 
INP060 
1NP061 
INP062 
INP063 
INP064 
INP065 
INP066 
INP067 
INP068 
1NP069 
1NP070 
1NP071 
INP072 
INP073 
INP074 
INP073 
INP076 
INP077 
INP078 
INP079 
INP080 
INP081 
INP082 
INP083 
INP084 
INP085 
INP086 
INP087 
INP088 
INP089 
INP090 
INP091 
INP092 
INP093 
INP094 
INP093 
1NP096 
INP097 
1NP098 
INP099 
INP100 
INP101 
INP102 
INP103 
INP104 
INP103 
INP106 
INP107 
I NP 108 
INP109 
I  NP  110 
INP111 
1NP112 
1NP113 
INP114 
1NP115 
INP116 
INP117 
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IF  I lRJUNCINlK) .tU.tRJUNC IN)  )  GO  TO  9004  INP116 

IFC  I 1KJUNC I N I K ) .EU. IRJUNC I N )  )  .AND.  (NIR.Nt.N)  )  GO  TO  9004  INP119 
IF(  < £K JuNC (NIK) .tO. I RJUNC I N ) ) )  GO  To  9004  JNP120 

103  CONTINUE  INP121 

GO  TO  8000  INP122 

INP123 

GtT  HERt  IF  ANC  CARO  READ  INP124 

INP125 

2  I NDt X=DATA ( 3 )  1NP126 

I F ( ( OaT A I 3 ) • LT . 1 . ) .OR. t DAT A C 3  I • GT . 44 . ) )  GO  TO  9001  INP127 

IFI ICHtCKI INDEX) .NL.0)  GO  TO  9002  JNP128 

INP129 

GtT  HERt  IF  DATA  OK  —  COUNT  ANCHOK  AND  STORt  DATA  INP130 

INP131 

NANC  =NANC  +  1  INP132 

AN JUNC ( NANC ) =DAT  A ( 3 )  1NP133 

I  CHECK ( INDEX )  =  1  INP134 

22  DO  21  1=1*3  INP135 

21  PJUNCI I  *  INDEX) =DATA( 1  +  3 )  INP136 

GO  TO  8000  1NP137 

I NP 138 

GET  HERE  IF  DJNC  CARO  READ  INP139 

INP140 

3  1 F (  ( DATA ( 4 ) . tU. 1 « ) .OR. ( DATA ( 4 ) « EQ. 3 • t  I  GO  TO  9001  IHP141 

IFI  ( DATA ( 4  )  . tO • 2 • ) • AND • ( UA T A ( 5 ) • L T  .  1  .  )  )  GO  TO  9001  1NP142 

IFI DATA (3) .GT.1000. )  GO  TO  9001  INP143 

I F ( DAT A(4).GT«4.)  GO  TO  9001  INP144 

IFI0ATAI4I .LT- 1. )  GO  TO  9001  INP145 

IFI  IDATAI 3 ) -LT.l . ) .OR. (DATA13 ) .GT .44. I )  GO  TO  9001  INP146 

IFI  I0ATAI4 ) .t0.4. > . AND. (DATA  I  5 ) .Nt .0. )  )  CO  TO  9001  INP147 

IFI  I  DATA I7).LT.O.).OR.IDATA(8).LT.O.I)  GO  TO  9001  INP148 

IFI  DATA (4) .tO. 4.  )  GO  TO  8000  INP149 

I NDEX  =  0AT A  I  5 )  INP130 

IFI  IDtVI INDEX) .Nt.o  )  GO  TO  9003  INP131 

I  DEV  I  I NUEX )  =  1  I NP 1 52 

GO  TO  6000  INP153 

I NP 154 

GtT  HERE  IF  DCAb  CARO  RtAD  1NP155 

I NP 156 

4  DO  41  1=1*4  INP157 

ID=DATAI4)  INP158 

IFI I D» tO. I )  GO  TO  42  INP159 

41  CONTINUE  I NP 160 

GO  TO  9001  INP161 

42  IF  1  I (DATAI4) .E0.3. ) .OR. IDATAI4) .10.4. ) ) .AND. (DATAI5) .NE*0.  I  )  GO  TOINP162 

1  9001  I NP 163 

IFI  IDATAI 3 ) .LT. 1. ) .OR. IDATAI 3 ) .GT.22. ) )  GO  T09001  INP164 

IF l l IDATAI 4) .tO.l. ) .OR. I0ATA14 ) .tO.2. ) ) .AND. I  I  DAT A  I  5 ) .LT . 1 . ) .OR.  I  D I NP 1 65 
1ATAI 5) .GT.1000.  )  )  )  GO  TO  9001  INP166 

IFI  IDATAI7) .LT.O. ) .OR. (DATAlb) .LT.O. ) )  GO  TO  9001  INP167 

IFI  l IDATAI4) .tU.2. ) .OR. (DATAI4 J .E0.4. I  I  .AND.  (DATA! 9) .NE.O. (  I  INP16e 
1  GO  TO  9001  I NP 1 69 

IFI  I  I  DATA  I  4 )  .  EO. 1 • ) .OR . I  DATA  1 4 ) . EO. 3 . ) ) . AND . I  DATA  I  9 ) . LE . 0. )  )  INP170 
1GO  TO  9001  1NP171 

IFI  DATAI10).LT.0.  )  GO  TO  9001  INP172 

IFI  I  DATA  I  4 ) . tO . 3 . )  .OR.  I  DAT A  I  4 ) . tU . 4 . )  )  GO  TO  8000  INP173 

INDEX=DATA( 5)  I NP 174 

IFI  IDtVI INDEX) .Nt.O  )  GO  TO  9005  INP175 

1DEVI INDEX) =1  I NP 176 
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GO  TO  8000 

1NP177 

1 

c 

1NP178 

1 

c 

GET 

HERE  IF  CAB  CARD  READ 

INP179 

1 

c 

INP180 

5 

1NDEX=DATA( 3 1 

INP181 

IFI  IDATAI3) -LT.l. ) .OR. IDATAI3) .GT.22. ) )  GO  TO  9001 

INP182 

IFI  DATA (4  J .EO.DATA ( 5  >  )  GO  TO  9001 

INP183 

IF  t  IDATA14) .GT.44. ) .OR. (DATAI5 ) .GT.44. ) )  GO  TO  9001 

INP184 

IF (  (DATA(4).LT.l.J.OR.(DATA(5).LT.l.J)  GO  TO  9001 

INP185 

I F (  (DATA! 7) -LE.O. I .OR. ( DATA ( 8 ) .LF .0. ) .OR . ( DATA ( 9 ) . LE.O. ) 

INP186 

1 

.  .OR.IEX.LT.O.) .OR. (DATA! 10).LT.O. 1  I  go  TO  9001 

INP187 

IFI (DATA(IO).EQ.O.) .AND. (EX.NE.O.))  GO  TO  9001 

INP188 

IFI (DATA! 10) .NE.O.) .AND. (EX.EO.O. ))  GO  TO  9001 

INP189 

*■£« 

IFI  INSEG.LT.D.OR.INSEG.GT.50)  )  GO  TO  9001 

INP190 

IFI  1CABI INDEX) .NE.O)  GO  TO  9003 

INP191 

1CABI INDEX ) =1 

INP192 

\'Sr 

INDEX=DATA 1 5 ) 

INP193 

• 

IFI  I  CHECK  1 INDEX). NE.O)  GO  TO  9002 

INP194 

ijf 

I CHECK  1  INDEX )  =  1 

1NP195 

c 

INP196 

c 

GET 

HERE  IF  DATA  OK 

INP197 

Si'- 

c 

INP198 

IND£X=DATAI3) 

INP199 

•  r 

zjunci index )=  datai4) 

INP200 

LJUNCI INDEX )=  DATA! 5) 

INP201 

51 

nnode i index ) =  nseg+i 

INP202 

WCAB 1  INDEX ) =  DATA ( 6 ) 

INP203 

- 

CDCAB 1  INDEX ) =DATA 1 7 ) 

INP204 

DC AD  I  INDEX ) =DATA 1 8 ) 

INP205 

HI  INDEX ) =  DATA  1 9 ) /NSEG 

INP206 

EC  1  CAD  I  INDEX ) =  DATA  110) 

INP207 

EXPCABl 1NDEX)=  EX 

INP208 

GO  TO  8000 

INP209 

c 

INP210 

c 

GET 

HERE  IF  DEN  CARD  READ 

INP211 

c 

INP212 

6 

IFIDATAI3J.LE.O.)  GO  TO  9001 

INP213 

IFRHO=IFRHO+l 

INP214 

IFI  IFRHO.GT • 1  >  GO  TO  9006 

INP215 

RHO=  DATAI3 ) 

INP216 

GO  TO  1003 

INP217 

c 

1NP218 

c 

GET 

HERE  IF  EOD  CARD  READ 

INP219 

c 

1NP220 

9 

1 FEOD= 1 F EOD+1 

INP221 

DO  90  J=1.10 

INP222 

90 

DAT AT  I  I  ROW  »J)=DATAIJ) 

INP223 

I RMAX= I  ROW 

INP224 

IF  I  FATE .NE .0 • )  RETURN 

INP225 

IFI  IFLG.EO.l)  GO  TO  91 

INP226 

GO  TO  500 

INP227 

91 

I READ= I 5AV1 

INP228 

I FLG=0 

INP229 

GO  TO  500 

INP230 

c 

INP231 

c 

GET 

HERE  IF  NJNC  CARD  READ 

INP232 

c 

INP233 

10 

IFI  (DATA! 3) .LT.2. ) .OR. ( DATA! 3 ) .GT.44. )  )  GO  TO  9001 

INP234 

IFJNC= IF JNC+1 

1NP235 

l 


n  n  n  non  non  >-nnn 


NEL  REPORT  7  640  49 

IF<  IFJIMC.GT.1)  00  TO  9006  INP236 

N0JUNC=0ATA(  3)  INP237 

GO  TO  1003  INP238 

INP239 

GET  HERE  IF  NDAT  CARO  READ  INP240 

INP241 

12  NDATC=NDATC+1  INP242 

IF(NDATC.NE.lFtOD)  GO  TO  901b  INP243 

GO  TO  998  INP244 

2701  |FCOMP=0  1NP245 

INDAT=0  INP246 

IFVEL  =  0  1NP247 

IFANG=0  1NP248 

IF! ( DATA { 3 ) •  LT  »  0  • ) .OR. ( DATA  <  3I.GT.2.) )  GO  TO  9001  INP249 

X VOPT=DATA ( 3 )  1NP250 

IF  (NDATC.EQ.il  GO  TO  1270  INP231 

IF  (IVOPT.EQ.O)  GO  TO  1201  1NP262 

IF  (KFLG.EQ.O)  GO  TO  1271  1NP253 

IF  (  IVOPT.EQ.KCUR)  GO  TO  1201  INP254 

GO  TO  9117  INP255 

1270  IF  (IVOPT.EQ.O)  GO  TO  1275  INP256 

1271  KFLG=1  INP257 

K.CUR=IVOPT  INP25B 

GO  TO  1201  INP259 

1275  KFLG=0  INP260 

1NP261 

READ  ONE  INPUT  RECORD  FROM  PARAMETRIC  STUDY  SOURCE  DECK  INP262 

INP263 

1201  READ! IREAD. 1004)  ( DATN ( I ) *1  =  1*10) »EXX  »NNSEG  INP264 

DO  1209  1=1,14  INP265 

IF(DATN(2) .EQ.TtST I  I ) )  GO  TO  (9018.1208.1208.1208*1206*9016,1207,  INP266 

1  1203.1260,9018,1202,9018,9018,9018) »I  INP267 

1209  CONTINUE  INP268 

CALL  SWT CH  INP269 

GO  TO  9000  INP270 

I NP271 

GET  HERE  IF  VEL  CARD  READ  INP272 

INP273 

1202  IFVEL= I FVEL+1  INP274 

CALL  SWTCH  INP275 

IF( IVOPT.EQ.O)  GO  TO  9016  INP276 

I F ( IFVEL.NE.l)  GO  TO  1225  INP277 

NVSEG=0  INP278 

DO  1224  1=1,25  INP279 

2VEL ( I ) =0.  INP280 

1224  VELZ( I  1=0.  INP281 

1225  NVSEG=NVSEG+1  INP282 

IF (NVSEG.GT ,25)  GO  TO  9006  INP283 

ZVEL ( NVSEG ) =DAT  A ( 3 )  INP284 

DO  111  K=1 , NVStG  INP285 

IF ( (ZVEL(NVSEG) .EO.ZVEL(K) ) .AND. (K.NL .NVSEG) )  GO  TO  9006  INP286 

111  CONTINUE  INP287 

VELZ(NVSEG)=DATA<4)  INP2B8 

GO  TO  1201  INP289 

INP290 

GET  HERE  IF  ANG  CARD  READ  INP291 

INP292 

1203  IFANG=IFANG+1  INP293 

CALL  SWTCH  INP294 
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IF( 1V0PT.EQ.0)  GO  TO  9018 

IF < IFAN6.EQ.1)  NANG=0  ' 

IFIDATAI4I.LE.0.)  GO  TO  9001  ~ 

1 F (  DATAI5) .LT.DATAI 3)  I  GO  TO  9001 
THE  TAB  =  DATA ( 3 1 
THET  AS=  OAT  A 1 4 ) 

TH£TAE=  OAT  A 1 5  ) 

NANG=NANG+1 

I F  C  NANG.GT.l)  GO  TO  9006 
GO  TO  1201 
C 

C  GET  HERE  IF  COMP  CARD  READ 
C 

1207  IFCOMP= IFCOMP+ 1 
CALL  SWTCH 

I F ( IFCOMP.EO.l)  NCOMP=0 
IF<DATA(3J.LE.0.)  GO  TO  9001 
NCOMP=  NCOMP+1 
I F (  NCOMP.GT.l)  GO  TO  9006 
COM PO 3 DAT A ( 3  I 
GO  TO  1201 
C 

C  GET  HERE  IF  PARAMETERS  ARE  BEING  CHANGED 
C  LOCATE  RECORD  TO  BE  CHANGED  AND  BRANCH 
C 

1208  IF ( INDAT.NE.O)  GO  70  12081 

READ ( 1NTAPE.31 )  ( ( DATAT ( I  .  J ) . J= 1 . 10 ) » I  =  1 » 1 RMAX ) 

REWIND  INTAPE 
INDAT=1 

12081  DO  1290  I=1,IRMAX 
I  ROW- I 

IF  C I DATN ( 1 ) . EQ. DATAT ( 1ROW.1 ) ) .AND. ( DATN 1 2  I • EC. DATAT I IROW.2) ) ) 
1  GO  TO  1206 

IFIDATATI IROW.2 ) -EO. TEST (9) )  GO  TO  9017 
1290  CONTINUE 

1205  DO  12051  J=1.10 
12051  DATA ( J ) -DATAT I IROW.J) 

DO  1206  1=1,5 

IF  (0ATNI2  )  .ECJ.TLST  <  1  I  )  GO  TO  1 1  206  » 12 10 . 1 220 , 1 230  » 1 240  I  ,  I 

1206  CONTINUE 
C 

C  GET  HERE  IF  ANC  CARD  READ 
C 

1210  IF ( DAT  A ( 3 ) .Nt • DATN 13))  GO  TO  9017 
CALL  SWTCH 
INDEX=DATA ( 3 ) 

GO  TO  22 
C 

C  GET  HERE  IF  DJNC  CARD  READ 
C 

1220  DO  1222  1=3,5 

I F ( OAT A ( I  I .Nt.DATNI I ) )  GO  TO  9017 
1222  CONTINUE 

CALL  SWTCH 

I F I ( DATA (7I.LT.0.) «OR . ( DATA I8I.LT.O.I)  GO  TO  9001 
GO  TO  8000 
C 

C  GET  HERE  IF  DCAB  CARD  READ 
C 
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INP296 
I NP297 
INP298 
INP299 
INP300 
INP301 
INP302 
INP303 
INP304  " 
INP305  -3 
INP306  i 
INP307 
INP308 
INP309 
INP310  ^ 
INP311 
1NP312 
INP313 
INP314 
INP315 
INP316 
INP317 
INP318 
INP319 
INP320 
INP321 
1NP322 
INP323 
INP324 
INP325 
INP326 
INP327 
INP328 
INP329 
I NP330 
I NP331 
INP332 
INP333 
INP334 
I NP335 
INP336 
INP337 
INP338 
INP339 
INP340 
INP341 
INP342 
INP343 
INP344 
INP345 
INP346 
'  INP347 
INP348 
INP349 
INP350 
INP351 
INP352 
1NP353 
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1230  1  F  (  (  DATA  (  3).Nt.DATN(3)).OR.( OAT  A(  5  )  .fit*  DATN !  6  )  )  )  GO  TO  9017 
DO  1231  1  =  1. 3. 2 

F*  I 
G=  I  + 1 

IF ( ( ( DATA ( 4 ) .EO.F ) .OR. (DATA (4 ) .  EG.G ) ) • AND • ( (0ATNI4) .EO.F). OR.! 
1(4).E0.G)) )  GO  TO  1232 

1231  CONTINUE 
GO  TO  9017 

1232  CALL  SWTCH 

IF!  I  (DATA(4) »tQ.2. > .OR. IDATA(4) .t0.4.  )  ) .AND. (DATAI9) .NE.O*  )  ) 
1  GO  TO  9001 

IF!  !DATA!7) .LT.O. ) .OR. <DATA<8 ) .LT.O.  ))  GO  TO  9001 
IF!  I (DATA! 4) .EO. 1. I .OR. ( DATA (4 ) . E0.3 . >  > . AND . ( DAT A ( 9 ) .LE.O. )  ) 
1GC  TO  9001 

IF!  DATA(IO) .LT.O.  )  GO  TO  9001 
GO  TO  6000 

GtT  HERE  IF  CAD  CARO  READ 


GO  TO  9017 


1240  DO  1241  1=3.5 
IF (DATA! I ) .NE.DATN! I ) ) 

1241  CONTINUE 
CALL  SWTCH 
EX=EXX 
NSEG=NNSEG 
INDEX  =  DAT  A ( 3 ) 

IF!  (DATA! 7) .LE.O. I -OR. (DATA! 8 ) .LE .0. ) -OR. (DATA  I  9)  .LE.O.  J 
1  .OR. (EX. LT.O. ) .OR. (DATA! 10) .LT.O. ) »  GO  TO  9001 
IF  I ( DATA! 10) .EO.O. ) .AND. ItX.NE.O. ) )  GO  TO  9001 
IF  I tUMTAl 10) .NE.O. > .AND. (LX.tO.O. ) )  GO  TO  9001 
IF!  INSEG.LT.il .OR. (NSEG.UT* 50)  )  GO  TO  9001 
GO  TO  51 

GtT  HERE  IF  EOD  CARO  READ 

1260  1FE0D= IFEOD+1 

IF (FATE  »NE . 0 . )  RETURN 
GO  TO  601 

GtT  HERE  IF  LUN  CARD  READ 

13  INTAPE=DATA(51 
I F  LO  =  GATA ( 6 ) 

IF! (  IFLG.LT.O) 

ISAV1=DATA(3) 

IF { IFLG.EO.O) 

IF!  IFLG.EO. 1 ) 

OFLG=DATA!8 ) 

IF! 10FLG.LT .0) .OR. (OFLG.GT .2) ) 

IF  I OFLG.EO.O)  0UTAPc=DATA<4) 

1 F ( OFLG.NE . 0 )  OuTAPE=DATA( 9) 

IF ( ( IPKNT.EQ. I  READ) .OR. (  I PRNT .EQ. INTAPE ) .OR. I  1  Or  LG. NE . 0 ) . AND . 
1  (  I  PRNT  .  EO.  OUT  APE  )  )  .OR.  (  INTAPt  .EO.  I  READ)  .OR.  (  i.NTAPL  «  EO.  OUT  APE  ) 
2!  I  RE AD. EQ. OUT APE  I .OR . ( (  1 FL G . EO . 1 ) .AND. (  I R t AD . EO . I S AV 1 ) ) ) GO  TO 
GO  TO  1003 

14  IF (  (  IF tOD-NDATC ) .Nt . 1 )  GO  TO  9016 
IF (OFLG.EO.O)  GO  TO  141 

WRITE! OU  TAPE.142)  TEST(14) 

142  FORMAT! A4. 14 *3£15.8 ) 


.OR. (  IFLG.GT.l) )  GO  TO  9001 

I HtAD=DATA ( 3 ) 

I R t AD  =  DA  T  A ( 7 ) 


GO  TO  9001 
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INP375 
INP376 
INP377 
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^  ^  ^  ^  ^  ^  n  n  o  a  o  ^  ^  ^ 


52 


R.A.  SKOP  AND  J.  MARK 


141  V.'R  I  TE  <  IPRNT  •  140  ) 

140  FORMAT l 1H1. 18HANALYSIS  COMPLETED ) 

FATE  =  1 • 

RETURN 

CHECK.  TO  SEE  IF  SUSPENDED  ARRAY  SOURCE  DECK  COMPLETE 

500  IF( < IFJNC.EQ.O) .OR. ( 1FRH0.EO.01 .OR. (NANC.EQ.O) I  GO  TO  9007 

510  IF ( FATE.EQ.O. )  GO  TO  2000 
RETURN 

CHECK  TO  SEE  IF  PARAMETRIC  STUDY  SOURCE  DECK  COMPLETE 

501  IF( ( IVOPT.EQ.OI .OK. ( 1V0PT.EO.2) >  GO  TO  5101 
NZL  =  0 

1FINVSEG.EQ.0I  GO  TO  9008 
IF (  IFVEL.EQ.O)  GO  TO  549 

SORT  VELOCITY  PROFILE  BY  Z-COOROINATE 

550  DO  555  I=1,NVSEG 
K=  I 

DO  555  J=K*NVSEG 

IF I  ZVEL I  I > .LE.ZVELtJ) I  GO  TO  555 
TEMP=ZVEL ( I ) 

ZVEL l 1 ) =ZVEL ( J ) 

ZVEL ( J 1 =TEMP 
TEMP  =  VELZ I  I ) 

VELZl 1 J=VELZ(JI 
VELZC J)=TEMP 
555  CONTINUE 
549  INDEX=ANJUNC( 1 ) 

ZANCM-PUUNC I  3 . INDEX ) 

IFCNANC.EQ.1I  GO  TO  511 
DO  508  N  =  2  * NANC 
INDEX=ANJUNC(N J 

IF  C  PJUNC  <  3.  INDEX)  .LT  .ZANCI-i )  ZANCM  =  PJUNC  t  3  .INDEX  ) 

508  CONTINUE 

511  00  509  N= 1 .NVStG 

IF  1 ZVEL IN) .Lt .ZANCM)  NZL=NZL+1 

509  CONTINUE 

IFC (NZL.EQ.O).OR.CNANG.EQ.O) I  GO  TO  9008 
5101  IF  (NCOMP.EQ.O)  GO  TO  9008 
IF  (  INOAT. NE.G)  GO  TO  4000 
505  CONTINUE 
RETURN 

CHECK  ON  CONTINUITY  OF  CABLE  NUMBERING  ANO  COUNT  CABLES 

20U0  NCAD= ICABC22) 

DO  2  uu 1  N= 1 »  2 l 
NCAB  =  NCAB+ I  CAB  IN ) 

JMCAo«N)-lCAbIN+l> 

IF  (J.LT.O)  GO  TO  9009 
2001  CONTINUL 

IF  (NCAB.EQ.O)  GO  TO  9009 

CHECK  ON  CONTINUITY  OF  JUNCTION  NUMBERING  AND  COUNT  JUNCTIONS 


INP413  ! 
INP414 
1NP415 
INP416 
INP417 
INP418 
1NP419  v 
INP420 
INP421  4 
1NP422  A. 
1NP423  a? 
INP424  -<k 
INP425 
INP426  '*> 
INP427  '.** 
INP428 
INP429 
1NP430  -4 
1NP431  :.■& 
INP432 
1NP433 
INP434  ^ 
INP435 
INP436  Gi 
1NP437  ■< 
1NP438  ■■/.'•S 
INP439  ^ 
1NP440  ,-S 
INP441  ■  -jf 
INP442 
1NP443  4- 
1NP444 
1NP445 • 4 
I NP446  -H 
I NP447 
INP448 
1NP449  ' 
1NP450  A 
INP451 
INP452 
inp453 
INP454 
INP455 
INP456 
INP457  yf 
INP458 
1NP459  ■-?* 
1NP460  --1? 
INP461 JAi 
INP462 
INP463  'V? 
INP464  ■••.Ef 
INP465- 

INP466 

INP467  -L 
I NP468  4' 

INP469  -A 
1NP4  70 
I NP4  7 1 •  4 
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2002 

NJUNC= 1 CHECK ( 44 ) 

1NP472 

00  2003  N=l»43 

INP473 

NJUNC=NJUNC+ ICHECK ( N ) 

INP474 

J  = I CHECK (N)-ICHECK(N+1 ) 

INP475 

IF  (J.LT.O)  GO  TO  9010 

INP476 

2003 

CONTINUE 

INP477 

INP476 

CHECK  ON  CONTINUITY  OF  DEVICE  NUMBER  I  NG  AND  COUNT  DEVlCtS 

INP479 

INP480 

2004 

N0EV=10EV( 1000) 

INP481 

DO  2005  N= 1 *999 

INP482 

NDEV=NDEV+ I  DEV ( N ) 

1NP483 

J= IDE V (N)-IDEV(N+1) 

INP484 

IF  (J.LT.O)  GO  TO  9011 

INP485 

2005 

CONTINUE 

INP486 

2007 

IF  (FATE.EQ.O.)  GO  TO  3000 

INP487 

RETURN 

INP488 

1NP489 

GET 

HERE  IF  ARRAY  NUMBERED  CORRECTLY 

INP490 

CHECK  TO  SEE  IF  NIR  CONSISTENT 

INP491 

INP492 

3000 

N  IRC=NCAB+NANC-NOJUNC 

INP493 

IF  (NIR. NE. NIRC)  GO  TO  9013 

I NP4  94 

3001 

IF  (FATE.EQ.O.)  GO  TO  4000 

INP495 

RETURN 

1NP496 

INP497 

GET 

HERE  TO  MAKE  FINAL  CHECK  ON  1 N T ARE 

INP498 

INP499 

4000 

1=1 

INP500 

4009 

DO  4001 J= 1 i 10 

INP501 

4001 

DATA ( J ) =DAT  AT ( I.JI 

INP502 

1  =  1  +  1 

INP503 

IF  (DATAI2) .EO.TEST ( 1 ) )  GO  TO  4002 

INP504 

IF  ( DATA (2).EQ.TEST(3))  GO  TO  4003 

INP505 

IF  ( DATA (2) .EQ.TEST (4) )  GO  TO  4004 

INP506 

IF  ( DAT  A ( 2  I .EO.  TEST ( 5 ) 1  GO  TO  4005 

INP507 

IF  (DATA(2) .EO.TEST ( 9) )  GO  TO  4006 

INP508 

GO  TO  4009 

INP509 

INP510 

GET 

HERE  FOR  IR 

INP511 

INP512 

4002 

101 =DAT  A  <  3 ) 

INP513 

102  =  DAT  A ( 4 ) 

INP514 

I F ( ( 1D2.GT .NOJUNC ) .OR. ( ID1 .LE .NOJUNC ) .OR. ( SD1 .GT .NJUNC ) )G0 

TO  9014 I NP5 1 5 

GO  TO  4009 

INP516 

INP517 

GET 

HERE  FOR  DJNC 

INP518 

INP519 

4003 

I D  =  DAT  A  t  3 ) 

INP520 

IF( 10. GT. NJUNC )  GO  TO  9014 

INP521 

GO  TO  4009 

INP522 

INP523 

GET 

HERE  FOR  DC Ab 

INP524 

INP525 

4004 

1 0  =  DA  T  A ( 3 ) 

1NP526 

IF  (I0.GT.NCAB)  GO  TO  9014 

INP527 

RL  =  H( ID )  *  ( NNODE (  ID) -I  1 

INP528 

IF  (DATA! 10) .GE.RL )  GO  TO  9014 

INP529 

GO  TO  4009 

INP530 
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GET  HERE  FOK  CAB 

*005  ID=DAT  A  (  4  ) 

IF<  1D.GT.NJUNC)  GO  TO  9014 
GO  TO  4009 

GET  HERE  FOK  E0D 

*006  WRITE( 1NTAPE*31)  I t DATAT ( I  * J ) » J  =  1 • 10 ) » I  =  1 « I RMAX ) 

31  FORMAT (F4.0*A4#8E15. 8) 

REWIND  INTAPt 
IF  IN0ATC.NE.0)  KtTURN 
IF  (FATt.EQ.O.)  GO  TO  5000 
RETURN 

GET  HERE  IF  ALL  OK.  AND  CALCULATE  PATH 
K.  IS  CABLE  COUNTER 

>000  K  =  0 

LOOP= 1  LOOKING  FGK  CABLES  LEAVING  ANCHORS 
LOOP= 1 

JMINP  REMEMBERS  FIRST  VALUE  OF  K  ON  A  LEVEL  OF  TREE 
JMINP=1 

JKAX  REMEMbERS  NUMBER  OF  CABLES  ON  A  LEVEL  OF  TOPOGRAPHIC  TREE 
JMAX=NANC 

I F ( LOOP • EO • 1  )  GO  TO  5002 
50G1  JMAX=K 

IF  ( (LOOP.EO.l ) .AND. IK.NE .1 ) )  GO  TO  9015 

IF  I (LOOP.EO.2) .AND. ( JM1N. to. JMINP) )  GO  TO  9015 

IF  ( K.  .EO.NCAB )  GO  TO  5008 

LOOP=2 

5002  JMIN=JMINP 

DO  5C09  J=JMIN* JMAX 

LOOKING  FOR  CABLES  LEAVING  A  JUNCTION 

DO  5007  N=1.NCAB 
GO  TO  ( 5003 .5004) .LOOP 

5003  IF  (  l  JUNC  IN  )  .EU.  ANJUNC  (  J  )  )  C»u  TO  5005 
GO  TO  5007 

5004  IPATHJ=PATH( J) 

IF(2JUNC<N) .EO.LJUNCI IPATHJ) )  GO  TO  5005 
GO  TO  5007 

GET  HERE  IF  CABLE  N  STARTS  AT  JUNCTION  M 

5005  K=K+1 
PATH ( K ) =N 

GO  TO  15007.5006) .LOOP 
REMEMBER  HERE  FIRST  VALUE  01  <  ON  TREE  LEVEL 


INP531 

INP532 

INP533 

INP534 

1NP535 

INP536 

INP537 

1NP538 

INP539 

INP540  „ 

INP541 

INP542  i 

INP543 

INP544 

INP545  -i; 

INP546 

INP547 

INP548 

INP549 

INP550 

1NP551 

INPS52  4 

INP553  * 

I NP554  -i 

INP555 

INP556  4 

INP557  ~ 

1NP558  *; 

1NP559  u 

INP560 

INP561  • 

INP562 

INP563 

INP564 

INP565 

INP566  ■:• 

INP567 

1NP568 

INP569 

INP570 

INP571 

INP572  ■ 

INP573 

1NP574 

INP575 

INP576  - 

INP577  v 

INP578 

INP579 

INP580 

INP5  81 

INP582  vE 

INP583  4 

INP584  -v 

INP585  t 

INP586 

INP587 

INP583  : 

INP589 
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5006  1FJJMAX.E0.  (K.-1  ))  JMlNP-K. 

50u7  CONTINUt 

5009  CONTINUE 
60  TO  5001 

5008  CONTINUE 

IFIFATt.NE.O.)  RETURN 
WRITE! 1PRNT  #5010) 

5010  FORMAT I///.5X.1 8MNO  tRRORS  OETECTEU ) 

GO  TO  1003 

PUT  DATA  INTO  DATA  ARRAY 

8000  IF ! IFEOD.NE.O)  GO  TO  8003 

IF  «  (  !  DATA  (2  )  .El).  TEST  (  3)  )  .OR .  (  DATA  (  2  )  .  EQ.  TEST  1  4  )  )  ) 
l.ANO. (DATA15 ) .NE.O.  )  )  GO  TO  8001 
GO  TO  8003 

8001  ID=DATA ( 5 ) 

DO  8002  J=l»10 

DATAT! I  ROW. J)=DATAT( ID.J) 

8002  DATAT! ID . J ) =DAT A ( J ) 

GO  TO  8005 

8003  DO  8004  J=l#10 

8004  DATAT ! I  ROW# J )  =  DATA ( J ) 

IF! IFEOU.NE.O)  GO  TO  1201 

8005  IROW=IkOW+i 

IF  I  IR0W.LE.2150)  GO  TO  1003 
WRI TE  < IPRNT  #8006) 

8006  FORMAT < 6X . 2 H 1 7 . 1 8X . 4 5HC0MM0N/B 1 /  bOUND  EXCEEDED. 

1.  ) 

GO  TO  1003 

THIS  SECTION  GENERATES  ALL  ERROR  MESSAGES 
9116  FATE=1. 

WRITE! IPRNT .9  500)  I ER.  DATA! 1)  .0ATAI2) 

9500  FORMATI6X.I2.4X.F4-0.3X.A4) 

IF! IER.L0.12)  GO  TO  4009 
IF! IER.EQ.16)  RETURN 

IF (NDATC.EQ.O)  GO  TO  1003 
GO  TO  1201 
90U0  I ER=0 

GO  TO  5116 

9001  I ER= 1 

GO  TO  9116 

9002  I ER=2 

GO  TO  9116 

9003  I ER=  3 

GO  TO  9116 

9004  I ER=4 

GO  TO  9116 

9005  I ER=  5 

GO  TO  9116 

9006  I ER=6 

GO  TO  9116 

9007  I ER  =7 

WRITE!  IPRNT .9501  >  1ER  # IF JNC  .IFRHC.NANC 

9501  FORMAT  <6X. I  2 .18X.5I 3 ) 

FATE- 1 

GO  TO  510 


INP590 
1NP591 
INP592 
INP593 
1 NP594 
INP595 
1NP596 
INP597 
1NP598 
INP599 
INP600 
INP601 
INP602 
INP603 
INP604 
1NP605 
INP606 
INP607 
INP608 
INP609 
INP610 
INP611 
INP612 
1NP613 
INP614 
INP615 
INP616 

SEE  USERS  MANUAL  I NP61 7 
INP618 
INP619 
INP620 
INP621 
INP622 
INP623 
INP624 
INP625 
INP626 
I NP627 
INP628 
1NP629 
INP630 
INP631 
INP632 
INP633 
INP634 


INP635 

INP636 

INP637 

INP638 

INP639 


INP640 
INP641 
INP642 
INP643 
I NP644 


INP645 

INP646 

INP647 


INP648 


ihf 


56 

R.A.  SKOP  AND  J.  MARK 

9008 

I  ER  = 14 

1NP649 

FATE  =  1 

INP650 

WRITE! I PRNT  *  950 1 ) 

I ER .NCOMP . I VOPT .NVSEG .NZL .NANG 

INP651 

GO  TO  505 

INP652 

9009 

I  ER  =  8 

INP653  . 

FATE= 1 

INP654 

WRITE! 1PRNT. 95021 

1ER.< ICAB! 11.1=1.22) 

INP655 

GO  TO  2002 

INP656 

9010 

IER  =  9 

INP657 

FATE= 1 

INP658  • 

WRITE! IPRNT. 9502) 

IER. ( 1  CHECK ! I ) . 1  =  1.44) 

INP659  • 

9502 

FORMAT I6X.I2.18X. 

4412) 

INP660  -y 

GO  TO  2004 

INP661 

9011 

IER= 10 

I NP662 

FATE=1 

I NP663 ' >■ 

WRITE! IPRNT  *9504 ) 

IER. ( I  DEVI  I ) .1  =  1.1000  ) 

INP664  V, 

9504 

FORMAT I6X.I2.12X. 

10011. 9I/.20X. 100111 ) 

INP665 

GO  TO  2007 

INP666  X 

9013 

I ER= 1 1 

INP667 

FATE=1 

INP668  X 

WRITtl I PRNT  *9501  ) 

lER.NCAb.NANC.NOJUNC.NIRC.NIR 

INP669  .¥ 

GO  TO  3001 

INP670 

9014 

1  ER  =  12 

INP67I  X 

GO  TO  9116 

INP672  ‘v 

9015 

I  ER= 1 3 

1NP673 

FATE  =  1 

INP674  -£ 

WRITE! IPRNT. 9507) 

IER 

INP675  V 

GO  TO  5008 

INP676  X 

9507 

FORMA  TI6X.I2.18X. 

94M I f IPROPER  ARRAY  REOUCTIUN  OR  JUNCTION 

NUMBERING! NP677 

1.  CHECK  TREE  REPRESENTATION  OE  ARRAY  !  SEE  ARRAY  » /  ►  20X  »  83HREDUCT  IO  I  NP678 

2N  SECTION  OF  USERS  MANUAL)  AGAINST  JUNCTION  NUMBERING  ON 

ANC  AND  CINP679 

3Ab  CARDS. ) 

INP680  - 

9017 

DATA! 1 ) =DATN ( 1 1 

INP6  81 

OAT  A ( 2 ) =DATN ( 2 ) 

INP682 

9117 

I  ER=  1 5 

INP683  • 

GO  TO  9116 

INP684 

9013 

I  ER  =  1  6 

INP685 

IF ( IFEOO.EO.O)  GO 

TO  9116 

INP686  •; 

DATA! 1 )=DATN(  1  ) 

INP687  - 

DATA  1 2  I =DATN ( 2  ) 

INP688  - 

GO  TO  9116 

INP689 

END 


INP690 


U  KJ 
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SUBROUTINE  PHSOUT  PHS001 

PHS002 

THIS  ROUTINE  GENERATtS  INFORMATION  CONCERNING  the  Physical  PHS003 

c  CHARACTERISTICS  of  The  STRUCTURAL  CABLE  ARRAY  PHS004 

c  PHS005 

COMMON  /bl /  FE JUNC  » 1 R  .DtLTA 1 .DELTA, IRS,  TF JUNC  .E.ES.FCAB.RCAB  , JUMP»PHS006 

PHS007 


IP JUNCS  *PCAB  * PC ABE  .PCAbO  .RCAbO, THETA,  PJUNCO 
COMMON  /B2/  NCAB.NNODE.ERJUNC.lRJUNC.DATA.OATN.h.PjUNC. 
lCDCAb .DCAb.F AT  t  *NANC • AN JUNC  , I Kc AD  »  1 PRNT *INTAPE*0UTAPE*ITIME*IFLG* 
20FLG»NlK.THETAS.ThtTAt  .COMPU.THt.TAB  .NJUNC  .RHO.TEST  • 

3NVSEG  *2VEL, VELZ.PIP .ECICAB.LXP Cab , 2 JUNC »L JUNC *PA  TH» 1CAB  , 1 VOPT  * 
4WCAb ,  IDLV*I  CHECK  *NDE  V  *NL)A  T  C 


DIMENSION 

1) 

DIMENSION 
DIMENSION 
DIMENSION 
DIMENSION 
DIMENSION 
DIMENSION 
DIMENSION 
INTEGER 


PHS008 

PHS009 

PHS010 

PHSOll 

PHS012 


FE JUNC (3*44)  *  I R ( 3  *44 ) *IRS(3*44) *TF  JUNC (3*44)  * PJUNCO ( 3  .44PHS01 3 

PHS014 

FCA8<  3*51 .221 • RCAb ( 3 . SI , 22 )  . P JUNCS ( 3 *44 ) » PC AB ( 3  * 5 1 *22 | 

PC ABE (3. SI .22) *PCAbO( 3 .51 *22  I *RCABO( 3 .51 *221 
MNUDE  (22)  » t  R  JUNC  ( 44  )  *IRJUNC(44)  *DATA(10)  .DATM10)  *H(22) 

P JUNC (3*441 .CDCAB ( 22 ) *DCAb(22) *ANJUNC(44) .TEST (14) 

Z  VEL  (25)  *VEL2(  251  *LClC/«b(22  I  *EXPCAu(22  )  .2  JUNC  (22) 

L JUNC (22)  *PATH( 22>  » ICAb(22) *WCAB(22) .IDEVt 1000) 

I  CHECK ( 44 ) 

OUTAPE  *Z JUNC  *ERJUNC  .AN JUNC *OFLG 


PHS015 
PHS016 
PHS017 
PHS01B 
PHS019 
PHS020 
PHS021 
PHS022 

INTEGER  PATH  PHS023 

REAL  IN* IRS  PHS024 

WRITE! IPRNT. 25)  PHS025 

25  FORMAT ( 1H 1  *  54HPHYS I  CAL  CHARACT tR I  ST  1 CS  OF  THE  STRUCTURAL  CABLE  ARPHS026 

1RAY)  PHS027 

WRITE! IPRNT .1 )  NANC  PHS028 

1  FORMAT (///* 19H  NO*  OF  ANCHORS  IS  .  I  2  . / / 5X ,64H JUNC T I  ON  NO.  X-COOPHS029 

1RDINATE  Y-COORD ) NATE  2-COOKD I  NAT E )  PHS030 

DO  2  N=1«NANC  PHS031 

INDEX=ANJUNC(N)  PHS032 

2  WR I TE ( I PRNT . 3 )  INDEX,! PJUNC (I. INDEX), 1=1*3)  PHS033 

3  FORMAT ( 10X, I2,4X,3( 5X.F10.2 »3X) )  PHS034 

NOJUNC  =  fiCAB  +  NANC-NlR  PHS035 

WRI Tt ( IPRNT *4)  NO JUNC  PH5036 

4  FORMAT (// *39H  NO.  OF  JUNCTIONS  IN  ORIGINAL  ARRAY  IS  .12)  PHS037 

WRITE ( IPRNT *5)  NIR  PHS03B 

5  FORMAT!//, 39H  NO.  OF  CUTS  MADE  IN  ORIGINAL  ARRAY  IS  .I2//1H  .2(5X,PHS039 

1 1 2H JUNCT I ON  NO. ) */ .3X.6H0F  CU  T  *  6X  *  1 7HAT  WHICH  CUT  MADE)  PHS040 

IF(NIR.EO.O)  GO  TO  3C  PHS041 

DO  6  N  = 1 , N I R  PHS042 

6  WRI TE < IPRNT  ,7)  I R JUNC (N )  « ER JUNC < N I  PHS043 

7  FORMAT ( 1CX, 12. 15X,  12  )  PHS044 

30  WRITE*  IPRNT. 8)  NCAU  PHS045 

8  FORMAT*//, 18H  NO.  OF  CABLES  IS  *  I  2  * // 5X *  1 fcHCABLL  S  =  0  S  =  L  , 43X .4HPHS046 

1DRAG.19X  *22HCONST I  TUT  1  Vt  NO.  OF ,/,6X, 3 UNO. *1X*2(2X,4HJUNC) *3X*  PHS047 

26HLENGTm,03X  *8  HD  I  AML  TER  ,  3X  ,  13Hv.'t  I  GUT  /  LENGTH  ,3X  *  1  lnCGEFF  ICIENT  *3X»  PHS048 
38HR 1 G I D I T  Y , 6X  » UHL XPONENT * 5X  * BHE LEMENT S )  PHS049 

00  9  N-l.NCAB  PHS050 

NSEG^NNODE ( N ) -1  PHS051 

RL=H(N)»NSEG  PHS052 

9  WRITE (  (PRNT  .  10)  N , 2 JUNC ( N )* L JUNC ( N ) »RL . DC AB ( N ) .WCAB ( N )  .CDCAB (N ) *  PHS053 

1  EC  I  CAB ( N ) , FXPCAB ( N  )  . NSEG  PHS054 

10  FORMAT ( 6X, I  2 .5X. I  2 »4X,  12  ,  IX »F9. 1  ,3 (3X »F 7.3 .4X) ,  F  10.0 »7X .F6 . 3 »  PHS055 

19X.12  )  PHS056 

WRITE ( IPRNT . 11 )  PHS057 

11  FORMAT (// .63H  PROPERTIES  OF  THE  DEVIClS  LOCATED  AT  JUNCTIONS  ARE  APHS053 
IS  FOLLOWS  . //6X.6MDEVICE . 10X ,6rOE V  ICE ,9X ,1 lHDEVICt  DRAG  , 4X *  1 4H Ot V 1 PhSO 5 9 
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N0..8X.6HWEIGHT  . 9X  .  1 1HC0EF F I C l ENT .9X » 


2CE  FRONT  AL  »/ »5X  .9HJUNC • 

34HAREA) 

12  READ! INTAPE. 13)  (DATA  (11*1  =  1*10) 

13  FORMAT (F4.0.A4.8E15.8) 

IF(DATA<2)  .EQ.TESTO)  >  GO  TO  14 
IF(0ATA(2) .E0.TtST(9)l  GO  TO  16 
GO  TO  12 

14  JUNC=DATA(3> 

WR I TE ( I PRNT  *  15 )  JUNC  » ( DATA ( K ) .K=6.8) 

15  FORMAT (8X*I2»9X*F10.2»6X»F10.3*6X*F10.2) 

GO  TO  12 

16  REWIND  INTAPE 

WRI TE ( I PRNT • 24 )  NDE V 

24  FORMAT!//. 32H  TOTAL  NO.  OF  lNOtXLO  DEVICtS  IS. 14) 

WR I TE ( 1 PRNT . 17 )  IVOPT 

17  FORMAT!//. 25H  CURRENT  FIELD  OPTION  IS  .11) 

IV= I VOPT+1 

GO  TO  (22.18.22)  .IV 

18  WRITE! IPRNT. 19) 

19  FORMAT ( /7X1 2HZ-COORD I NATE.6X.11HVELOCITY  OF./.8X.10 
112HCURRENT  AT  Z) 

DO  20  N= 1 .NVSEG 

20  WRITE (  1PRNT .21 )  ZVtL(N) .VElZ(N) 

21  FORMAT (2X.5X.F10.2.10X.F7.2) 

22  WRITE ( IPRNT. 23)  COMPD 

23  FORMAT!//. 38H  ACCURACY  REGuIRtO  IN  CALCULATIONS  IS 
IF(OFLG.NE.O)  WRITE! IPRNT. Ill )  NDATL 

111  FORMAT!//. 30H  DEVlCC  LOCATION  OUTPUT  RECORD » I  3 .2 1H 
1ARRAY  ) 

RETURN 

END 


.F6.2) 


PHS060 
PHS061 
PHS062 
PHS063 
PHS064 
PHS065 
PHS066 
PHS067 
PHS068 
PHS069 
PHS070 
PHS071 
PHS072 
PHS073 
PHS074 
PHS075 
PHS076 
PHS077 
PHS078 
CURRENT .7X.PHS079 
PHS080 
PHS081 
PHS0e2 
PHS083 
PHS084 
PHS085 
PHS086 
PHS087 
PHS088 
PHS08V 
PHS090 


REFERS  TO  THIS 
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SUBROUTINE  STROUT  STR001 

STR002 

THIS  ROUTINE  GENERATES  THE  ARRAY  STRUCTURAL  OUTPUT  STR003 

STR004 

COMMON  /Bl/  FEJUNC  * IR*DtLTAl *DcLT A . I RS . TF JUNC *E * ES .FCAB *RCAB * JUMP *ST R005 
1PJUNCS.PCAB»PCABE  *PCAbO*RCAbO»ThETA.PJUNCO  STR006 

COMMON  /D2/  NCAB .NNODE .ERJUNC * 1RJUNC » DAT A  .DATN *H .P JUNC *  STR007 

1CDCaU.DCAB.FaTE  tNANC * AN JUNC  *  I  RE AD » I PRNT . 1 NT APE .OUTAPE *  I  TIME  .  IFLG*  STR008 
20FLG *N 1 R. THE TAS . Tut T AE .COMPD ♦ ThE TAB*N JUNC »RHO» TEST  *  STROOV 

3NVSEG  »ZVEL .VELZ.P1P .ECICAfa  *c.XPC AB » 2 JUNC  *LJUNC  .PATH. ICA8  » IVOPT  *  STR010 
4WCA3  > IDLV » I  CHECK  »NDEV  .iNDATC  STR01X 

DIMENSION  FEJUNC ( 3  .44 ) ,IRt3.44) ,IRS<3.44) .TF JUNC ( 3 .44 ) *PJUNCOI 3 *44STR012 

STR013 

DIMENSION  FCAB (3 .51 .22)  .RCAB(3*51 *22) .PJUNCS I  3 *44 ) .PCAB13.51 *22)  STR014 
DIMENSION  PC ABE (3.51 . 22 ) * PC ABO (3.51.22) «RCAbO(3. 31*22)  STR015 

DIMENSION  NNOOt 122)  . ER JUNC ( 44 ) *IRJUNC(44) .DAT  A ( 1 0 )  *  DATN  1 1 0 )  .H(22)  STR016 
DIMENSION  P JUNC ( 3 . 44 ) *CDCAB(22) .DCABI22)  .AN JUNC ( 44 ) *TEST(14)  STR017 

DIMENSION  ZVEL ( 25 )  *VELZ<25>  *ECICABI22) • EXPCAB ( 22 ) *  Z JUNC ( 22 )  STR018 

DIMENSION  L JUNC ( 22 )  . PATH ( 22  I • I C AB ( 22 ) .WCABI22) .IDE VI 1000)  STR019 

DIMENSION  I  CHECK  I  44 )  STR020 

INTEGER  0UTAPE*ZJUNC*ERJUNC.ANJUNC*0FLG  STR021 

INTEGCR  PATH  STR022 

REAL  IR  *  1 RS  STR023 

DIMENSION  TEMPI (3)  *  T  EMP2 ( 3 ) »  TEMP3 I  3 ) .D1SPI3  > .PSPACEI 3)  STR024 

DIMENSION  A ( 3 ) *B ( 3 ) >D(3)«U(3)*V(3) >W( 3 ) »C ( 4 ) .RQ! 3 ) »R I ( 3 )  STR025 

NOJUNC=NCAB+NANC-N  I  P.  STR026 

JUM= JUMP+1  STR027 

GO  TO  1 1 00  *200 ) • JUM  STR028 

100  WRITE! IPRNT.1002)  STR029 

1002  FORMAT l 1H1 .33HARRAY  EQUILIBRIUM  WITH  NO  CURRENT  ///)  STR030 

GO  TO  300  STR031 

200  WRITEIIPRNT  *1001)  THETA  STR032 

1001  FORMAT! 1H1.35HARRAY  EQUILIBRIUM  WITH  CURRENT  FR0M.F8.2*  9H  DEGREE SSTRO 33 
1  ///)  STR034 

STR035 

GENERATE  ANCHOR  HEADERS  5TR036 

STR037 

300  WRITE! IPHNT.1003)  STR038 

1003  FORMAT (1H  *  1 3HARRA Y  ANCHORS  )  STR039 

WRITE! IPRNT. 10031 )  5TR040 

003  1  FORMAT  (1H  *13H - - /)  STR041 

WRITE! IPRNT.1004)  STR042 

1004  F0RMATI1H  >  32HJUMC.  NO.  CABLE  AT  TENSION  AT  * 14X *26HFORCE  CSTR043 

10MP0NENTS  AT  ANCHOR . 13X . 16HCABLE  ANGLES  WRT I  STR044 

WRITE! IPRNT. 1005)  STR045 

1005  FORMAT !1H  *  30HOF  ANCHOR  ANCHOR  ANCHOR 8 X  »6HX-C0MP  *6X  *6HY— C0MSTR046 

IP . 6X .6HZ-C0MP . 3X .9HH0R • -COMP .5X.16HX— AXIS  XY-PLANE )  STR047 

STR048 

THIS  SECTION  CALCULATES  FORCES  AND  ANGLES  AT  ANCHORS  STR049 

STR050 

DO  401  J1  =  1 » NANC  STR051 

J3=0  STR052 

402  J2  =  1  STR053 

404  IF  (ANJUNCI Jl) .EO.ZJUNC! J2 ) )  GO  TO  403  STR054 

414  J2= J2+1  STR055 

IF! J2.LE.NCAB)  GO  TO  404  S:R056 

IF(NIR.EO.O)  GO  TO  401  STR057 

412  J3  = 1  STR058 

411  IF (ANJUNCI Jl ).E0.ERJUNC!J3) )  GO  TO  405  STR059 
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Bv»„ .  f  RH2  =  Rrt  _  , 

RY-  2 1  {  ip(«m»e9-«)  RH-*. 


x'FfRHx.  Ea.  Ol  «H  =  0. 


413  J3=J3+1 

IF! J3.LE.NIR)  00  TO  411 
GO  TO  401 

406  IN0EX= 1RJUNC1 J3 ) 

DO  406  J4=l  *NC  AD 

IF! INDLX.EQ.LJUNCI J4) )  00  TO  407 

406  CONTINUE 
GO  TO  401 

407  MM,  =  J4 
MX=NN00E(J4) 

T=TCAb I MX. MM) 

RX=— RCAB ( 1 .MX. KM) 

RY=-RCAb  <  2 »MX»MM.) 

RZ=-RCAb ( 3  * K X  » MM ) 

GO  TO  408 

403  K,M= J2 

T«TCAUI1,KM) 

RX=RCAb( 1 ,1 ,MM) 

RY=RCAb(2.1*MM) 

R2=RCAb(3,l,MM)  r  RH2  'RH 

40£  Rh=SGRT IRX**2  +  RY*»2  )  }  t.c  r  an  i  .  s  «J  ■  o  )  RHS1 

Al=ASlN(RY/RH)/PIP  1  r 

A2  =  AS1N(R2/T)/Pl^  -  X'pfRrtx.Ea.  olRHsO. 

IF! (RX.LT.O. l-ANU. (RY.GE.O. > )  A1=180.-A1 
IF(  (  RX.LT.O.  1  .AND.  ( RY.LT.O. ) )  A1=-180.-A1 
WRITE  (IPRNT .1006)  ANJUNC  (  J1  )  ».'IM  *T  »KX  *RY  *R2  *RH.A1  *A2 
1006  FORMAT ( 1H  . 3X . I  2  » 9X » I  2  .SX  »F 10 . 1 » 3X *4 « F 1 0 . 1 »2X ) .2 ! 2X *F 7. 2 . 1 X  I) 
IF! J2.LT.NCAb)  GO  TO  414 

1 F  C  ( J2.EO.NCAB ] .AND. ! J3.LO-0 )  )  GO  TO  412 

I F (  ( J2.EO.NCAB ) .ANu. I J3.NC.NJUNC )  )  GO  TO  413 

401  CONTINUE 

GENERATE  CAdLE  HEADERS 

WRITE! IPRNT.2000) 

2000  FORMAT (1H  *///lH  • 1 2HARRA Y  CAbLES  ) 

WRITE! IPRNT. 2001) 

2001  FORMAT  I  1H  •  1 2H - - /) 

WRITE! I PRNT  »  2002 ) 

2002  FORMAT! 1H  .120HCAULC  MAXIMUM  S-COORD  MINIMUM  S-COORD  MAX 

1  S-COORD  LOCATION  OF  THIS  POINT  NO  CURRENT  LOC.  OF  TH 

2 INT  ) 

WRITE! IPRNT .2003) 

2003  FORMAT! 1H  ,120H  NO.  TENSION  OF  TENSION  Or  DI 

1  OF  X-COOKD  Y-COOKD  Z-COOkO  X-COORD  Y-COORD 

2R0  ) 

THIS  SECTION  CALCULATES  MAXIMUM  A.NO  MINIMUM  CARLE  TENSIONS 
AND  MAXIMUM  CABLE  ul SPL ACEMLNTS  FROM  NO  CURRENT  LOCATION 
BY  EXTRAPOLATION  bt TWEEN  CABLE  NGDcS 

INITIALIZE  tXTREMA 

DO  799  NN=1 *NC Ab 
N  =  NN 

TMAX=TCAB( 1 *N) 

STM.AX^O. 

TM IN- IMAX 
STM  IN =  0. 


MAXIMUM  S-COORO 
OF  THIS  POINT 


MINIMUM  S-COORD  MAX 
NO  CURRENT  LOC.  OF  TH 


TENSION 

Y-COOKD 


OF 

COUkD 


TENSION 

X-COORD 


or 

Y-COORD 


STR°60 

STR06I 

STP.062 

STR063 

STR064 

STR066 

STR066 

STR067  • 

STR068 

STR069 

STR070 

STR071  ? 

STR072  v 

STR073 

STR074 

STR07S 

STR076 

STR077 

STR078  ■ 

STR079 

_ fcSTR080 

_  STR081 

*STR082 
STR083 
STR084 
STR086 
STR086 
STR087 
STR088 
STR089 
STR090 
STR091 
STR092 
STR093 
STR094 
STR09S 
STR096 
STR097 
5TR098 
I MUM  STR099 
IS  POSTRIOO 
STR101 
STR102 
SP.  STR103 
Z-COOSTR104 
STRlOb 
STR106 
STR107 
STR108 
STR109 
STR1 10 
ST  R 1 1 1 
STR112 
STR113 
STR1 14 
STR11S 
STR116 
STR117 
STR118 


^  %V* 
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GO  TO  ( 802*801) *JUM 
301  DMAx=0. 

00  700  1=1*3 

700  DMAX=DMAX+ { PCAB ( I • 1 .N ) -PC ABO ( 1 *1*N) )**2 
DMAX=SORT ( OMAX ) 

SDMAX=0. 

802  MX=NN0DE(N)-1 
DO  750  MM=1 *MX 
M=MM 

Ml =MM+1 

CALCULATE  EXTRAPOLATION  QUANTITIES 

RR  =  0. 

RD  =  0. 

D0=0« 

DO  701  1=1,3 

0(1)  =  ( RCAb ( I *Ml*N)-RCAb(  I  *  M  *  N ) )/H(N) 

GO  TO  (804*803)  *  JUM 

803  At  I )=EXCAB(M.N)»RCAB( I *M ,N ) /TCAB ( M *N ) 

B( I )=(EXCAH(M1»N)*RCAB( I ,M1*N)/TCAU(M1*N)-A( I ) )/H(N) 
U(  I  )  =  PCAB  (  I  *M*N )  -PC A130  (  I  *M,N) 

804  RR=RR+RCAB( I »M*N)*RCAb( I «M,N> 

RO=RD+RCAB( I *M*N)*D( I ) 

701  DO=DD+D ( I ) *0 ( I ) 

GO  TO  (306,805) .JUM 

805  DO  702  1=1,3 

TEMP  1 ( I ) =RCAb ( I ,M*N> 

TEMP2  t I ) =RC Ab (  I ,M1 ,N ) 

RCAb  (  I  «M»N  )  =RCAUO(  I  »M,N) 

702  RCAb ( I ,Ml,N)=RCAbO( I ,M1.N) 

UU  =  0. 

UV  =  0. 

UVW  '  0. 

VW=0. 

WW  =  0. 

DO  703  1=1,3 

V(  I  )  =  t  XC  Ab  {  M  *N  )  *RCAt>(  I  ,  M  ,  N  )  /  TC  A  0  (  M  .  N  ) 

W(  I)  =  (tXCAQ  (Ml  ,N)  »RCAli(  I  ,  M 1  ,  N  !  /  TC  Au  ( i;  1  ,  N  )  -V  (  I  )  )  /  H  (  N  ) 

V( I ) =A( I )-V( I ) 

v;<  I )  =  (b(  i  >  — w ( I )  )/2. 

UU=  UL'+U  (  1  )*U(  1  ) 

UV=UV+U( I ) *V( I ) 

UVW=UVW+2.*U! I )*K(  I ) + V ( I ) >  V  <  I  ) 

VW=VW+V( I)*W( I ) 

703  WW  =  WV(+Vj  (  I  )  »V.  (  I  ) 

00  704  1=1,3 

RCAb  (  I  »f ! ,N )  =  TEMPI  (  I  ) 

704  RCAbl 1 .Ml ,N) =TLMP2( I ) 

806  C(4)=C. 

C ( 3 ) =0 • 

C ( 2 ) =D0 
C( 1 ) =RD 

call  RPCL Y ( C ,R0 , K I ) 

calculate  tension  extrema  IN  SEGMENT 

JT l ME  =0 
DO  71V  1=1,3 
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I F I  Rim.NE.O.)  CjO  TO  719 

IFCCRQCI).LE.O.).OR.(RU<I).GE.H(Mn  GO  TO  719 
SIG=R0( I ) 

710  TE=SQRT  (RR+2.*KD*SlG+DD*SIG**2) 

IFITE.GT.TMAX)  GO  TO  712 

IF(TE.LT.TMIN)  GO  TO  713 

711  IF ( JTIME.EQ.O)  GO  TO  719 

GO  TO  715 

712  TMAX=TE 
$TMAX=H(N)*(M-1 )+SlG 
GO  TO  711 

713  TMIN=TE 
STMIN=H(N)*<M-1)+SIG 
GO  TO  711 

719  CONTINUE 
JT1ME=1 
S1G=H<N) 

GO  TO  710 

715  GO  TOI750.716) »JUM 

716  C(4)=2.*WW 
C  <  3 ) =3 . *VW 
C(2)=UVW 
C(l)=l 

CALL  RPOLYIC.RQ.RI ) 

CALCULATE  MAXIMUM  DISPLACEMENT  IN  SEGMENT 

JTIME=0 
DO  729  1=1,3 

IF  (RHI).nE.O*)  GO  TO  729 

IF  I  (RQU  J.LE.O.  I. OR.  (RO(H  .GL.HINJ  >  >  GO  TO  729 
SIG=R0( I ) 

720  DE=SQRTCUU+2.*UV*SIG+UVK*SIG**2+2.*VW*SIG»*3+WW*SIG**4) 
IFIDE.GT.OMAX)  GO  TO  722 

721  IF! JTIME.EQ.O)  GO  TO  729 
GO  TO  750 

722  DMAX=DE 

SDMAX=  MINI* (M-l) +SIG 
GO  TO  721 
729  CONTINUE 
JTIME=1 
SIG=H(N) 

GO  TO  720 

750  CONTINUE 

EXTREMA  ALONG  A  CAULE  NOW  DETERMINED 

CALCULATE  FINAL  AND  INITIAL  COORDINATES  OF  MAXIMALLY  DISPLACED  POINT 

GO  TO  (810.809) »JUM 
809  RL=H ( N ) *MX 

IF ( SDMAX.LT.RL )  GO  TO  760 
K=LJUNC (N) 

DO  751  1=1.3 
A (  I  )  =  P JUNC  t 1  »K1 

751  B(I>=PJUNCOt 1 »K) 

GO  TO  780 

760  DATA ( 2 ) =  TEST ( 4 ) 

DATA ( 3 ) =N 
DAT  A  t 1 0 ) =SDMAX 
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J=  I  SDMAX/H I  N )  )  + 1 
J1=J+1 

DO  761  11=1*3 
1  =  11 

761  A(I)=SPACEm 
DO  762  1=1,3 

TEMPI ( 1 )=RCA«(  1  * J  *N ) 

TEMP2  I  I )  =RCAU(  I  *  J1  »N ) 

TEMP3I I  )=PCAB<  1  »J»N) 

RCAB! 1  •  J,N) =RCAbOl I , J  *N) 

RCAB ( I ,J1.N)=RCAB0I I »J1»N) 

762  PCABI I ,J,N)=PCABO< I ,J,N) 

DO  763  11=1,3 

1  =  11 

763  B( 1 ) =SPACE ( I) 

DO  764  1=1,3 

RCAB t 1 . J,N) =TEMP1 I  1  ) 

RCA8I 1 , J1 ,N ) =TEKP2 ( 1  I 

764  PCAB1 1 ,J,N)=TEMP3t  I  ) 

780  CONTINUE 

WRITE ( I PRNT , 78 1 J  N  »  TMAX , ST MAX  »  TM 1 N  «  STM  IN  *DMAX  »SDMAX  ,  ( A ( 1 )  ,1  =  1 ,3) , 
1  IBID, 1  =  1, 3) 

GO  TO  799 

810  WRITE! 1PRNT ,781 >N» TMAX »STMAX » TMIN » STMIN 

781  FORMATI1H  *I4»1X»6F9.1»6F10«1) 

799  CONTINUE 
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STR263 

GENERATE  JUNCTION  HEADERS  STR264 

STR265 

WRITE! IPRNT ,1007)  STR266 

1007  FORMAT ( lh  ///1H  ,  15HARRAY  JUNCTIONS)  STR267 

WRITE!IP»NT, 10071)  STR268 

0071  FORMAT  (  1H  «  1  'JM - - /  )  STR269 

WRITE! IPRNT ,100b)  STR270 

1008  F0RKATI1H  .27HJUNC.  CABLt  »'.T  TENSION  A  T  ,3X ,  16HCA0LE  ANGLES  WRT ,  STR271 

110X.17H JUNCTION  LOCATION, 10X,33HDISPLACE;;ENT  FROM  NO  CURRENT  LOC.1STR272 

WRITE! IPRNT ,1009)  STR273 

1009  FORMAT! 1H  ,15H  NO.  JUNC T I 0N3X , bH JUNC T I 0N4X , 1 6HX-AX I S  XY-PLANE,  STR274 

168H  X-COORD  Y-COORD  Z-CCOHD  X-DISP  Y-DISP  Z-STK275 

2DISP  )  STR276 

STR277 


THIS  SECTION  CALCULATES  JUNCTION  FORCES,  LOCATIONS  AND  DISPLACEMENTS  STR27b 


STR279 

I F  =  0  STR280 

DO  601  J1 = 1 , NO JUNC  STR281 

DO  605  K.=  1  , NANC  STR282 

IF  I  AN JUNC ( K  >  • EO. J1 )  GO  TO  601  STR283 

605  CONTINUE  STR284 

GO  TO  ! 602 ,603 ) * JUM  STR285 

603  DO  604  J2= 1 ,3  STR286 

604  D I SP ( J2 ) =P JUNC !J2,Jl)-PJUNCu(J2,Jl )  STR287 

602  J6= 1  STR288 

608  IF! J1.E0.ZJUNCIJ6) )  GO  TO  606  STR289 

615  IF IJ1.EU. L JUNC ( J6 ) )  GO  TO  607  STR290 

617  J6= J6+1  STR291 

IF  I J6.LE.NCAB)  GO  TO  608  STR292 

IF(NIR.LO.O)  GO  TO  601  STR293 

J7=l  STR294 

609  IF ! J1 .EO.ERJUNC t J7) )  GO  TO  610  STR295 
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616 

J7= J7+1 

STR296 

IF! J7.LE.NIR)  GO  TO  609 

STR297 

GO  TO  601 

STR298 

606 

MM=J6 

STR299 

T*TCAi>!  1  .MM) 

STK300 

RX=RCAD(i.l ,hM) 

STR301 

RY=RCAB (2.1 .MM ) 

STR302 

R2=RCAB!3.1.MM) 

STR303 

GO  TO  611 

STR304 

610 

I NOEX= I R JUNC ( J7 ) 

STR305 

DO  612  J8=l.NCAb 

STR306 

IF!  INDEX. EO.LJUNC! J8JIG0  TO  613 

STR307 

612 

CONTlNUt 

STR30b 

613 

MM=J8 

STK309 

GO  TO  614 

STR310 

607 

MM=J6 

STR311 

614 

MX=NNODE (MM) 

STR312 

T»T CAB  I MX. MM I 

STR313 

RX*-RCAb(l»MX.MM> 

STR314 

RY»-RCAfa ( 2 .MX.MM1 

STR315 

RZ=— RCAb ( 3 .MX .MM ) 

STR316 

611 

RH  =  SORT(RX**2+RY*i2j _ XFiRH.EQ.oT  RH=<- 

STR317 

A1=AS1N(RY/RH)/PIP 

STR318 

A2  =  ASIN(RZ/T4I/PIP 

STR319 

IF! (RX.LT.O. ) .AND. (RY.GL.O.))  A1=180.-A1 

STR320 

IF! (RX.LT.O. J.AND. (RY.LT.O.II  A1=-18C.-A1 

STR321 

IF!  (  1F.LQ.0)  .AND.!  JUM.EO.l  )  I  WR  I  Tt  (  I  PRi.T  ,620  )  «J1  i 
KK.J1)  »IC=1.3I 

IF  I  (  IF  .LO.O)  .AND-!  JUM.eQ.2I  )  WRI  TE  ( I  PRNT  «620  )  J1 
1  IK.  J1 )  >X=1  .3  >  «  tDISPt  1 )  .  !  =  1  .3) 

IF(lF.EU.l)  WR I TE ( 1 PRNT  >620 )  J1 »MM»T »A1 *A2 
IF  =  1 

620  FORMAT { 1H  . 14  * 6X . I  2 »4X »F 1 0 . 1 » 3X .F7 .2 » 3X  . F 7 . 2 , 3 ( 1 X >F1C . 1 > . 1 X » 3 ( IX » 
1F10.1 ) ) 

IF(IJ6.LT.NCAb).AND.(Jl.EU.ZjUNC(J6))}  00  TO  615 
IF ( ( J6.LT.NCAb! -AND. ( Jl.EU.LJUNC ( J6]l )  00  TO  617 
601  I F  =  0 

GENERATE  INOEXEL)  DEVICE  HEADERS 


CABLES  J 


/) 


WRITE! IPRNT  *519  ) 

519  FORMAT (1H  *///lM  i 3 AH I NDE XED  DEVICES  ALONG  ARRAY 
WRITE!  IPRNT. 51911 

5191  FORMAT  (1H  .3 AH - - -  — - -  * 

WRITE  I IPRNT .520  ) 

520  FORMAT ( 1H  .7HUEVICt  .  5HC ABLE . 6X » IMS  * 7X . 1 OHTENS I  ON 
1  LOCAT  ION.  12X.36H  DISPLACEMENT  FRO;1.  NO  CURRENT  LOC.  ) 

WRITE! IPRNT. 521  J 

521  FORMAT! 1H  ,109HlNDtX  NO.  COORDINATE  DEVICE 

1  Y-COORD  2-COORO  X-DISP  Y-D1SP 

this  section  calculates  tensions  at  indexed  devices. 

DEVICE  LOCATIONS.  AND  DEVICE  DISPLACEMENTS 

IF  (NDEV.EQ.OI  GO  TO  511 
DO  510  N= 1 *NDEV 

READ  !  INTAPE  .501 )  ( DATA ( II . I  =  1 » 10 ) 

501  FORMAT  I  I  A , Aa . 8t 1 5 . 8 ) 

IF  1DATAI2) .L0.TESTI3) )  GO  TO  510 
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MM.T.A1.A2 . I PJUNCST  R324 
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STR332 
STK333 
5TR33A 
STR335 
STR336 
STR337 
STR338 
STR339 
STR340 

AT  .  13X , 1 5HDEVI  CESTR341 
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-DISP) 
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STR346 

STR347 

STR348 

STR349 

STR350 

STR351 

STR352 

STU353 

STR354 


I 


NRL  REPORT  7640 


65 


K«0ATA(31 

M=0ATA!  10I/H1K)  +  1 
INDEX=DATA ( 5 ) 

SIGMA=DATA! 10) - ( M-l ) *H I K ) 
TEN2=0. 

DO  502  11=1*3 
1  =  1 1 

PSP ACE ( 1 ) =SPACE ! I ) 
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502  TEN2=TEN2+ (RCAB ! 1 «M .K )  +  ( RCAB < 1 *M+1 ,K) -RCAB ( 1 »M*K } ) *SIGMA/H(K  ) )**2  STR363 


TEN=SORT ( TEN2 )  STR36A 

GO  TO  ( 503*505 ) *JUM  STR365 

503  WRITE  (IPRNT.5091  INDEX .K .DATA < 10 ) *TEN » ! PSPACE ( I ) *  I =1 .3 )  STR366 

GO  TO  510  STR367 

505  DO  506  1=1»3  STR368 

TEMPI! I )=RCABI I *M*K)  STR369 

TEMP2 ( I ) =RCA6( I . M+l »K )  STR370 

TEMP3 ( 1 )=PCABI I »M»K )  STR371 

RCAB (1 *M  »K ) =RCABO ! I *M  »K )  STR372 

RCAB! I .M+l,KJ=RCABO< I .M+l.K)  STR373 

506  PCABI I .M,KJ=PCAOO! 1 .M.K)  STR374 

DO  507  11=1*3  STR375 

STR376 

507  D ISP ( 1 ) =PSPACt ( I ) -SPACE (  I  )  STR377 

DO  508  1=1*3  STR378 

RCAB!  1  *M.M=TEMP1(  1  )  STR379 

RCAB! I.M+1.K)=TEMP2( I)  STR380 

508  PCAB ( I »M*K ) =TEMP3 ( I )  STR381 

WRITE! IPRNT  *509)  iNCEX  .K.  .DATA  <  10  )  .  TEN  .  <  PSPACE  !  I  )  .  I  =  1 . 3  )  •  STR382 

1IDISPI1J, 1=1*3)  STR383 

509  FORMAT  I 1H  *  1 4 . 4X , 1 2 ,4X ,F 9 • 1 » 3X  . F9 . 1 . 1 X  .  3 ( 2X  . F 1 0 . 1 ) . 4X . 3  1 1 X »F 10. 1 ) ) STR3 84 

510  CONTINUE  STR385 

511  REWIND  INTAPE  STR386 

RETURN  STR387 

END  STR388 
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SUBROUTINE  TAPOUT 

THIS  ROUTINE  GENERATES  THE  TAPE  OK  CARDS  GIVING 
THE  LOCATIONS  OF  THE  INDEXED  DEVICES 

COMMON  /bl/  FEJUNC.IK.DELTAI  .DlLTA , I RS . TF JUNC  |E  .ES  .  F CAb  .RCAb . JUMP  * 
1PJUNCS • PCAB  * PC ABE .PCAdO  .RCAbG . Tnt TA ,P JUNCO 
COMMON  /B2/  NC A6 1 NNCDE  »ER JUNC  .IRJUNC.  DAT  A.DATN.H.PJUNC* 

1 COCAB  »DCAB  .FATE.NANC  »ANJUNC  *  I  READ ♦ I PRNT *  INTAPE .OUTAPE *  I T IKE  * IFLG* 
20FLGtNl-» THETAS *THETAE .COMPD. THtTAb .N JUNC »RHO .TEST  * 
3NVSEG*ZVEL.VELZ.PIP.ECICAb.LXPCAb.ZJUNC .LJUNC.PATn. ICAb.IVCPT  * 
AWCAb.  1  DEV. 1  CHECK. NDEV.NDATC 

DIMENSION  FE JUNC (3. 44) . IR C 3 *44 ) . I RS ( 3 .44 ) . TF JUNC ( 3  *  44 ) *PJUNC0t3*44 

1) 

DIMENSION  FCAB (3.51*22) *RCAb<  3 • 51 . 22 ) .  P JUNCS ( 2 ♦ 44 ) .PCAB I  3 *51 *22) 
DIMENSION  PCABE 13*51*22) *PCAbO ( 3  *  5 1 *22 )  . RC AUO( 3  * 5 1 . 22 ) 

DIMENSION  NNOUE ( 22 ) *ERJUNC ( 44 ) *  I R JUNC (44) .DAT A I  1 0 ) . DATN ( 10) .HI  22 ) 
DIMENSION  P JUNC (3*44)  .CDCAb ( 22 ) .DCAB! 22 )  .AN JUNC (44 )  .TEST ( 14) 
DIMENSION  ZVEL (25) .VELZI25 ) .ECICAb <22 1 .EXPCAbl 22 ) .ZJUNC122) 
DIMENSION  L  JUNC  (  22  )  .PATH(22)  »ICAb(22)  .V.CAb  (  22  I  .IL'EVtlOOO) 
DIMENSION  I  CHECK ( 44 ) 

DIMENSION  PSPACE ( 3 ) 

INTEGER  0UTAPE.ZJUNC.EK JUNC. AN JUNC .OFLG 

INTEGER  PATH 

REAL  1 K  .  I RS 

ID1=4H  CUR 

ID2=4H  DEV 

ID3=4H  REC 

1  FORMAT ( A4, 14 .3F10.2 ) 

JUM= JUMP+ 1 

GO  TO  (2.3)  JUM 

2  WR1 TE ( CUT APE . 1 1  ID3.NDATC 
WRITEIOUTAPE.l )  ID1 . JUMP 
GO  TO  4 

3  WRITE ( OUTAPE . 1 ) ID1 .JUMP. THETA 

4  IF  (NOEV.EQ.O)  GO  TO  B 
DO  7  NN=1.NDEV 

READ! INTAPE .5)  < DAT A ( K ) *K  =  1  *  1 0 ) 

5  F ORMA T ( F4 • 0 . A4 . 8 E 1 5  •  6  ) 

INDEX=DATA ( 5 ) 


CALCULATE  LOCATION  OF  DEVICE  IN  SPACE 

DO  6  J= 1 • 3 

I«J 

6  PSPACE ( I )=SPACE( I ) 

WRITE (OUTAPE .1 ) 102 . INDEX .( PSPACE ( 11.1=1.3) 

7  CONTINUE 

8  CONTINUE 
REWIND  +NTAPE 
RETURN 

END 
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SUBROUTINE  ERROR  ERR001 

c  ERR002 

C  THIS  ROUTINE  GENERATES  a  TYPE  16  ERROR  MESSAGE  ERR003 

C  GET  HERE  IE  ALL  IMAGINARY  REACTIONS  DO  NOT  CHANGE  ERR004 

c  ERR005 

COMMON  /dl/  FEJUNC  »IR*DELTA1*DELTAiI KS  »  TF  JUNC  *E  *ES  *  F'CAB  *RCAB . JUMP*ERR006 
IP JUNCS  *PCAb»PCAUE  *PCAdO  *KCAdO»THETA»PJUNCO  ERR00  7 

COMMON  /d2/  NCAb  *NNODE  *ER  JUfiC  *  1  RJUNC  .DAT  A  »DATN  »H  »P  JUNC  *  ERR006 


IP JUNCS » PC Ab  » PC ABE  *PCAdO  *KCAdO»THETA  »P JUNCO  ERR007 

COMMON  /B2/  NCAb  *NNODE  *ER  JUfiC  *  1  RJUNC  .DAT  A  »DATN  »H  .P  JUNC  *  ERR006 

lCDCAb »DCAb  » FATE  *NANC *ANJUNC  •  IREAD * I PRNT • INTAPE  *OUTAPE » IT IME* IFLG»  EKR009 
20FLG*NIR»THETAS*TFiETAE  »COMPD  *THETAd».NJUNC»RHQ*TEST*  ERR010 

3NVSEG»ZVEL*VELZ*PIP  *EC IC Ad  «EXPCAb  » 2 JUNC *L JUNC  .PATH* I  CAB  *  I VOPT •  ERR01 1 
4WCAB. I DEV* ICHECK»NDEV*NDATC  ERR012 

DIMENSION  FEJUNC  <3*44) *IR(3*44) *IRS<3*44) *TF JUNC (3*44) *PJUNC0<  3*44ERR013 

ERR014 

DIMENSION  FCA6<  3*51.22|'*RCAB(3»51*22)  *P JUNCS  < 3*44)* PC AB (3*51. 22)  ERR015 
DIMENSION  PC ABE (3*51*22) * PC ABO (3*51*22) »RCAB 0(3*51*22)  ERR016 

DIMENSION  NNOUE (22 1 .ERJUNC (44) « I RJUNC (44) *DATA ( 1 0 ) * DATN ( 1 0 ) * H ( 22 )  ERR017 
DIMENSION  P JUNC (3*44) »CDCAB  <  22 ) *OCAb ( 22  )  » AN JUNC 1 44 ) *  TEST ( 14 )  ERR018 

DIMENSION  ZVEL (25) »VELZ(25  )  *ECICAB(22  >  *EXPCAb(22) *2 JUNC 122)  ERR019 

DIMENSION  L JUNC ( 22 )  *  PATH ( 22 ) »ICAB(22) »WCAB(22I *IDEV(1000)  ERR020 

DIMENSION  I  CHECK ( 44 )  ERR021 

INTEGER  OUT  APE . 2 JUNC  »  ERJUNC * AN JUNC  *OFLG  ERR022 

INTEGER  PATH  ERR023 


REAL  IR.IRS 
E»E*10* 

WRITE! IPRNT.l) 
FORMAT ( 1H1 *52H 


ERR018 

ERR019 

ERR020 

ERR021 

ERR022 

ERR023 

ERR024 

ERR025 


WRITE! IPRNT.l)  ERR026 

l  FORMAT ( 1H1 *52H  TYPE  18  ERROR.  STRUCTURAL  ANALYSIS  NOT  COMPLETED. ERR027 
1/60H  PRINTOUT  GIVEN  FOR  DIAGNOSTIC  PURPOSES.  SEE  USERS  MANUAL ./) ERR028 
JUM= JUMP+1  ERR029 


GO  TO  (4,6) * JUM 

4  WRITE ( IPRNT .5) 

5  FORMAT (5X.40HEX1 STING  CURRENT  CONDITION  IS  NO  CURRENT  / ) 
GO  TO  b 

6  WRITE! IPRNT  *7)  THETA 

7  FORMAT15X.38HEXISTING  CURRENT  CONDITION  IS  THETA  =  *F3.0/) 

8  WRITEI IPRNT. 9)  E 

9  FORMAT ( 5X.35HBEST  VALUE  OF  ACCURACY  ObT  A I  NED  IS  .F6.2) 

DO  2  N= 1 «NCAB 

NN  =  N 

WRITEI I PRNT *10)  NN 

10  FORMAT (//5X.29HTHE  TENSIONS  IN  CABLE  NUMBER  *12. 4H  ARE*/) 
L=NNODt (N ) 

DO  2  M  =  1  *  L 
MM  =  M 

T*TCAo (MM.NN) 

S=H(NN)*(MM-1.  ) 

2  WRITEI I PRNT  *  3 )  T.S 

3  FORMAT ( 7X.2HT= *F10. 2 *6H  AT  S=*F10.2) 

RETURN 

END 


ERR030 

ERR031 

EKR032 

ERR033 

ERR034 

ERR035 

ERR036 

ERK037 

ERR038 

ERR039 

ERR040 

ERR041 

EKR042 

ERR043 

ERR044 

ERR045 

ERR046 

ERR047 

ERR048 

ERR04V 

ERR050 


w  « 


. 
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C 

C 

C 

c 

c 

c 

c 

c 

c 


SUBROUTINE  RPOLY ( C *RR #R 1 ) 


evaluating  maximum  cable  displacements  and  tension  extrema 


real  parts  of  roots  ARE  PLACEO  IN  KK, 
SINCE  ONLY  heal  ROOTS  ARE  OF  INTEREST* 

non-existing  roots  return  kr=o  «  R I = 1 


IMAGINARY  PARTS  IN  RI 
ALL  NON-REAL  OR 


DIMENSION  C (4 J *RR( 3 ) »RI ( 3 ) 

IF(C (4) .NE.O. )  GO  TO  30 
IF ( C<3 ) .NE.O. )  GO  TO  20 
IF <C<2 ) .NE .0. )  GO  TO  10 
C 

C  GET  HERE  IF  EQUATION  IDENTICALLY  SATISFIED 

100  DO  1  1=1,3 
RRI I )=0. 

1  RI (  I  )  =  1. 

RETURN 

C 

C  GET  HERE  IF  EQUATION  LINEAR 
C 

10  RRI 1 ) =— C 1 1 ) /C I  2 ) 

RI ll)=0. 

200  DO  11  1=2,3 
RRI I>=0. 

11  RI I  1 )=1. 

RETURN 

C 

C  GET  HERE  IF  EQUATION  QUADRATIC 
C 


20  DISC=C (2 )**2-4.*C( 1  I *C< 3 ) 

IF IDISC.GE.O. J  GO  TO  21 
CO  TO  100 

21  RRI I  I  =  ( -C ( 2 ) +SORT (DISC) 1/(2. *C I  3) ) 
R 1 1  1 ) =0 . 

RR I  2 )  =  I -C I  2 1 -SORT (DISCI )/(2.*C(3>  ) 
R I ( 2 ) =0. 

RR ( 3 ) =0. 

RI (31=1. 

RETURN 

C 

C  GET  HERE  IF  EQUATION  CUUIC 
C 


30  P=C(3)/C(4) 

Q=C(2)/C(4) 

R=C( 1)/C(4) 

A=(3.»Q-p**2)/3. 

B=(2.*P**3-9.*P«0+27.*R)/27. 

DISC=  (B»*2 I /4.+(A**3>/27. 

IF (DISC  132,31,31 

31  D I  SC  =  SORT (DISC) 

CAPA=(((-B/2.+DlSC)*-*4)**(l./3.J)/(-t!/2.i-DISC> 

C APB  = ( ( (-ti/2.-DISC)**4)»*(l./3. 1 >/<-U/2.-DISC) 
RRI 1 )=CAPA+CAPB— P/3. 

RI ( 1 1=0- 

IF (DISC.GT.O.)  GO  TO  200 


RP0001 

RP0002 

RP0003 

RP0004 

RP0005 

RP0006 

RP0007 

PP0008 

RP0009 

RP0010 

RP0011 

RPO012 

RP0013 

RP0014 

RP001S 

RP0016 

RP0017 

RPO018 

RP0019 

RP0020 

RP0021 

RPO022 

RP0023 

RP0024 

RP0025 

RP002S 

RP0027 

RPO028 

RP0029 

RP0030 

RP0031 

RP0032 

RP0033 

RP0034 

RPO035 

RP0036 

RP0037 

RP0038 

RPO039 

RP0040 

RP0041 

RP0042 

RP0043 

RP0044 

RP0045 

RPO046 

RP0047 

RP0048 

RP0049 

RP0050 

RP0051 

RP0D52 

RP0053 

RP0054 

RP005  5 

RP00S6 

RPO057 

RPOOS8 

RPOOS9 


V  KJ  U 
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RR( 2 ) =-CAPA-P/3»  RP0060 

R I  I  2 ) =0«  RP0061 

RR  (  3  )  =  KR  {  2  )  RP0062 

R I ( 3 ) -0*  RPO063 

RETURN  RP0064 

32  DISC  =  2.* SORT  (-A/3. )  RPO06S 

PH 1 = AC05  ( t+3.»D)/(A*DISC) )/3.  RP0066 

RR(l)=-P/3.+DlSC*COS(PHl )  RP0067 

RR(2  )=-P/3.+DISC*COS(PHl  +  3.  I41S926SM2./3.  )  )  RP0068 

RR<  3)=-P/3.+DISC*COS(PHl+3.14IiV263*(4./3.  )  )  RP0069 

RI(1J=0.  RP0070 

R I ( 2 ) =0«  RP007I 

R I ( 3 ) =0 •  RP0072 

RETURN  RP0073 

END  RP0074 


SUOROUTINE  SWTCH  SWTOOl 

SWT002 

THIS  ROUTINt  SWITCHES  INPUT  DATA  SWT003 

SWT004 

COMMON  /bl/  FEJUNC. IR.DELTAl .UELTA.IRS.TF  JUNC  .E.ES.FCAB.RCAB  » JUMP  * SWT 00 6 
IP JUNCS  *  PC Ab  *  PC ABE  * PC ABO . RCAbO  .THETA.PJUNCO  SWT006 

COMMON  /B2/  NC AB  »NNODE  «ER JUNC  .IRJUNC.DATA  «DATN  *H  *  PJUNC  *  SWT007 

1CDCAB  *DCAb  »  FATE  .NANG  » AN JUNC  *  1  READ » I PKNT  *  I NTAPE .OUT APE  » l T 1 ME  *  I FLG  »  SWT008 
20F LG  »N I R  *  THETAS  *  THE  T  AE .COMPD . THETAB  »N JUNC  *RHO > TEST .  SWT009 

3NVSEG.ZVEL.  VtLZ.P  IP  ,ECICAb.LXPCAt>.  Z  JUNC  .L  JUNC  .PATH. I  CAB  t IVOPT •  SWT010 

4WCAB. lDt V. ICHECK..NUEV.NDATC  SWT011 

DIMENSION  Ft JUNC (3. 44) . 1 R ( 3 .44 ) . I RS ( 3 .44 )  .  TF JUNC 1 3 ► 4 4 >  .PJUNCO I  3 .44SWT012 
1)  SWT013 

DIMENSION  FCABI3.SI.22)  . RCAb ( 3 » b 1 . 22 )  .P  JUNCS  I  3 .44  )  .PCABO.S)  .22)  SWT014 
DIMENSION  PCABEI3.51 .22) . PC ABO < 3  .  b 1 . 2 2 )  . RC ABO 1 3 . b 1 . 2 2 )  SWTOlb 

DIMENSION  MNODE (22 ) .ER JUNC (44 1 . I R JUNC (44 )  .DATA l iO) .DATMt 10) »H(22 )  SWT016 
DIMENSION  PJUNCO. 44)  .CDCAB  (22)  .DCAt  (22)  ,ANJUNC(44)  »TEST(14)  SWT017 

DIMENSION  ZVEL ( 2b )  .VELZ(2b) .ECICAB(22) .EXPCAti  ( 22 ) . Z JUNC ( 22 )  SWT018 

DIMENSION  L JUNC (22 ) . PATH ( 22 >  *  I C AB ( 22  I .WCABI22 ) . I  DEV l 10001  SWT019 

DIMENSION  I  CHECK ( 44 )  SWT020 

INTEGER  OUTAPE.ZJUNC.ERJUNC.ANJUNC.UFLG  SKT021 

INTEGER  PATH  SWT022 

REAL  IR.IRS  SWT023 

DO  1  1=1.10  SWT024 

1  DAT  All)  =DATN ( I )  SWT02S 

RETURN  SWT026 

ENO  SWT027 
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SUBROUTINE  START  STA00I 

STA002 

THIS  ROUTINE  CALCULATES  THt  INITIAL  GULSSES  AT  THE  IMAGINARY  STA003 

AND  EQUILIBRATING  REACTIONS  AND  THE  INITIAL  DELTA  BASED  ON  STA004 

THE  TOTAL  WEIGHT  OF  THE  ARRAY  STAGOi 

STAOOb 

COMMON  /Bl/  FEJUNC*  IR.OELTAI *DELT A , I RS . TF JUNC  »E .ES . FCAB »RC AB .JUMP.STA007 
1PJUNCS  »PCAB » PC A BE  *PCABO  *  RCAbO • TuE  T  A  »  PJUNCO  STAOOb 

COMMON  /E>2/  NCABfNNOCE  *ER JUNC  *  I R JUNC  »  DATA  .DATN.H.PJUNC.  STA009 

1CDCAB  .DCAB.FATE  »NANC  » AN JUNC *  I  READ* IPRNT ♦ INTAPE  *OUTAPE  »  J  T I  ME  » IFLG  *  STA010 
20FLG  »N1 R  *  THETAS* THE TAE  *COMPL)  *THLT  AB »N JUNC »RHC . TEST  .  ST AO  11 

3NVSEG  «ZVEL  *  VELZ  .PJP.ECICAb.LXPCAB.  2 JUNC  »L JUNC  *PATH  *  I  CAB* IVOPT *  ST AO 12 

4WCAB, IDEV.ICHECK.NDEV.NDATC  ST AO  13 

DIMENSION  FE JUNC ( 3  *44 ) *  I R ( 3 *44 ) *  I RS ( 3 *44  )  .  TF JUNC ( 3  * 44 ) * P JUNCO ( 3  * 4 AST AO  14 
1J  STA015 

DIMENSION  F CAB  13*31  .22)  •  RCAb (  3  .  t>  1  *22  )  *P  JUNCS  t  3  *44  (  * PCAB  I  3  *  i>  1  * 22  )  STA016 
DIMENSION  PCABE 13*31*22) *PCAUO(3tbl»22)  .RCABO ( 3  *51  *  22 )  STA017 

DIMENSION  NNODE (22) *ERJUNC<44) • I R JUNC ( 44  )  .DATA ( 1 0 ) * DATN ( 10 ) * H ( 22 >  STA018 
DIMENSION  PJUNC( 3*44) *CDCAB(22) *DCAB( 22 )  .AN JUNC (44)  .TEST ( 14)  ST AO  19 

DIMENSION  ZVELI25) *VELZ(25) *LC1CAB(221 *EXPCAb<22>  *ZJUNC(22)  STA020 

DIMENSION  L JUNC ( 22 ) .PATH ( 22 ) * IC AB ( 22 ) .WCABI22 ) *  I  DEVI  1000 )  ST AO  21 

DIMENSION  I  CHECK ( 44  )  STA022 

INTEGER  OUT  APE  *Z JUNC  .ER JUNC  * AN JUNC .OF LG  STA023 

INTEGER  PATH  STA024 

REAL  IR.IRS  STA025 

WE  I GHT  =  0.  STA026 

DO  1  J  =  1  .NJUNC  STA027 

1  WEIGHT=WEI GHT  +  FE JUNC ( 3  » J  1  STA02B 

DO  2  N=1.NCAB  STA029 

I NNN= NNODE ( N ) -1  STA030 

DO  2  M=1,INNN  STA031 

2  WEI GHT  = WE  I GHT+  FCAb(3.M.N)  STA032 

DO  3  N=1,NIR  STA033 

KER=ERJUNC(N1  STA034 

DO  3  1=1,3  STA035 

3  I S ( I .KER 1=0*  5TA036 

DO  4  N=1.NIR  STA037 

K I R= I R JUNC ( N )  STA038 

KER  =  ERJUNC l N )  STA039 

IR(1.KIR)=0.  STA040 

IR(2.KIR)=0.  STA041 

IR(3.KIR)=-WEI  GHT  /  ( N  I  R+l.  loi  }  STA042 

4  I R^3  .KER)  =  IR(3»KER)-IR(3*K1K)  STA043 

DELTA  I =  ABS (WEI GHT  J / ( N I R+l )  STA044 

RETURN  STA045 

END  STA046 
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FUNCTION  TCAB(M,K) 


THIS  ROUTINE  CALCULATES  THE  TENSION  AT  NODE  M  OF  CABLE  K 

COMMON  /til/  FEJUNC  .  IR  .DELTA  I  .  OEL  T  A  ,  I  RS  .  TF  JUNC  , E  *  E  S  ,  FC  AB  , RC  AB  ,JUM 
1PJUNCS  .PCAB.PCABE ,P C ABO  ,  RC ABO  *  THE T A . P JUNCO 
COMMON  /B2/  NCAB, NNODE. ERJUNC.  IRJUNC  .DATA  .OATN  *H  tPJUNC  . 
lCDCAd.OCAB,FATE*NANG,ANJUNC . I  READ. 1  PRN  T  ,  I  NT  APE  *OUT  APE  *  I  T  I  .ME  *  IFLG 
20FlG*NIk*  THETAS, THtTAE  .CCMPD  »  The.  TAu  «N  JUNC  ,RHO  *  TEST  * 
3NVSEG,ZVEL*VELZ,PIP  .ECICAB.nXPCAu, Z JUNC .LJUNC .PATH* I  CAB* IVOPT* 
4WCAB.IDEV, ICHECK.NDEV 

DIMENSION  FEJUNC (3*44) *  I R I  3 *44 ) . I RS t 3 *44 ) * T F JUNC ( 3 » 44 )  *PJUNC0(3* 

1  ) 

DIMENSION  F CAB (3*51*22) . RC AB ( 3 . SI . 22 1  * P JUNCS t 3  * 44 ) • PCAB t 3 *31 *22 ) 
DIMENSION  PCABE  (3*31*22)  *PC AtiO (  3  *  5  1 . 2 2  )  *RCABO  13*31*22) 

DIMENSION  NNODE  (  22  )  ,t.RJUNC(44)  «  I  R  JUNC  (  44  )  .DAT  A  I  1 0  )  *DATN(10)  *H(22 
DIMENSION  P JUNC (3*44) ,CDCA6<22) *0Chb(22>  *ANJUNC<44) *  TEST! 14) 
DIMENSION  ZVEL125)  .VELZI25)  *ECICAti(22) *EXPCAb(22)  »ZJUNC(22) 
DIMENSION  LJUNC ( 22 )  *  PATH ( 22 ) » I C Ab ( 22 )  ,L‘CAB(22  >  *  I  DEV ( 1000 ) 
DIMENSION  I  CHECK ( 44 ) 

INTEGER  OUT  APE  *Z  JUNC  .ERJUNC.  AN  JUNC  *OFLG 
INTEGER  PATH 
REAL  I R ♦ I R  S 

TCAB  =SQRT (RCAbt 1 .M.K ) **2  +  RCAu t 2 >M *K ) **2  +  RCABI 3 *M*K ) **2 

RETURN 

END 


TCA001 
TCA002 
TCA003 
TCA004 
P  *  T CA005 
TCA006 
TCA007 
•  TCA008 
TCA009 
TCA010 
TCA011 
44TCA012 
TCA013 
TCA014 
TCA015 
)  TCA016 
TCA017 
TCA018 
TCA019 
TCA020 
TCA021 
TCA022 
TCA023 
)  TCA024 
TCA025 
TCA026 


FUNCTION  EXCABIM.K) 

THIS  ROUTINE  CALCULATES  (1  +  STRAIN)  AT  NODE  M  OF  CABLE  K 

COMMON  /ill/  FEJUNC  *  I  R  .  DE  L  T  A  1  *DL  L  T  A. .  I  KS  .  TT  JUNC  .  E  *  E  S  *  FCAB  *RCAB  * 
1PJUNCS.PCAB .PCABE .PCAbU. KCAbO.T HE T A. P JUNCO 
COMMON  /B2  /  NC  AB*  NNODE  *LR  JUNC  *  I  KJU.NC  .  DAT  A  *DATN  ,H  ,P  JUNC  * 
lCDCAo.DCAB.FATE.NANC  * AN JUNC » IRE  AD* I PRN T .INTAPE  *OUTAPE  » I  TIME  *  I 
20FLG.N I R. THETAS. THE TAE .COMPS .THE  TAB. N JUNC *  RHO .TEST . 

3NVSEG  . Z  VE  L  *  VELZ  *P  I P  » t  C  I C Ati  *L  XPC  AB  » Z  JUNC  .  L  JUNC  .PA  TH  *  I  CAB  *  I  VDPT 
4WCAB* I  DEV* I  CHECK  *NDEV*NDATC 

DIMENSION  FEJUNC (3.44)  * IR ( 3 .44 )  .  I RS ( 3 .44  )  ,TF JUNC ( 3  *44 )  *PJUNCO 

1  ) 

DIMENSION  F CAB (3*31  * 2 2 ) . RC AB ( 3 . 3 1 . 22 ) * P JUNCS ( 3*44 ). PCAB (3,51 » 
DIMENSION  PCABE  (  3*51  .22  )  .PCABJl  3  *51  *22  )  *RC  ALSO!  3.51  ,22  ) 
DIMENSION  NNODE ( 22 )  .ERJUNC (44)  »  IRJUNC ( 44 ) *DA T A ( 1 0  I  * Dt TN < 1 0 )  *H 
DIMENSION  P JUNC ( 3  *  4  4  )  ,  CDC Am ( 2 2 )  ,  DC AB ( 2 2  )  ,ANJUNC(44 )  ,  TEST ( 14 ) 
DIMENSION  ZVEL  (  25  )  *VELZ  <  25  )  .EC  I  CAB  (  22  )  »EXPCAu(?2>  »ZJUNC<22) 
DIMENSION  LJUNC (22 ) , PATH ( 22  )  .  I C Ab l 22  I  . WC Ab ( 22 ) *  I Dt V l 1000 ) 
DIMENSION  1  CHECK ( 44 ) 

INTEGER  OUT APE *Z JUNC .ERJUNC, AN JJNC. uFLG 
INTEGER  PATH 
REAl  Ik, IRS 

IF  (  E  XPCAD(K)  .10.0.  )  GO  TO  1 

EXCAB=1 •  +  ( TCAB (M  *K> /EC ICA;,  (K) ) **LXPCAB ( K ) 

RETURN 
1  EXCAB  - 1 • 

RETURN 

END 


EXC001 
EXC002 
EXC003 
EXC004 
JUMP . EXCO05 
EXC006 
EXC007 
FLG  *  EXC008 
EXC009 
,  EXC010 
EXC011 
(3*44EXC012 
EXC013 
22)  EXCC14 
EXCO  15 
(22)  EXCC16 
EXCC17 
EXCO  1 8 
EXC019 
EXC020 
EXCO  2 1 
EXC022 
EXC023 
EXC024 
EXCO  2  5 
EXC026 
EXC027 
EXC028 
EXCO 29 
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FUNCTION  EFORCE(I)  EF0001 

EF0002 

ROUTINE  CALCULATES  THE  DEVICE  FORCES  IN  DIRECTION  I  EF0003 

G  THE  NORMAL  DRAG  APPROXIMATION  FOR  IN-LINE  DEVICES  EFO004 

EFO005 

COMMON  /Bl/  FEJUNC.IR.DELTAl .DEL T A . I RS . TF JUNC .E . ES »FCAB »RCAB * JUMP .EF0006 


THIS  ROUTINE  CALCULATES  THE  DEVICE  FORCES  IN  DIRECTION  I 
USING  THE  NORMAL  DRAG  APPROXIMATION  FOR  IN-LINE  DEVICES 


1PJUNCS.PCAB  .PC ABE » PCABO. RCA60. THETA. PJUNCO 
COMMON  /B2/  NC A6  »NNODE  *CK  JUilC  *  IK JUNC .DATA  *DATN  *H*PjUNC* 


EF0007 

EF0008 


1CDCAB.DCAES.FATE.NANC.ANJUNC.IREAD. 1PRNT. INTAPE .OUTAPE . ITIME . IFLG.  EF0009 
20FLG »N IK. THETAS. THETAE.COMPU. THE TAB.N JUNC .RNO.TEST .  EFOOlO 

3NVSEG  »ZV£L  » VEL2  *P1P  .ECICAd.EXPCAb  .2  JUNC  »  L  JUNC  .PATH. ICAO.  I VCPT  .  EFOOU 

4WCAB.1DEV. ICHECK.NDEV.NDATC  EF0012 

DIMENSION  FE JUNC (3.44) .  IR<3*44) .IRS (3. 44) . TF JUNC ( 3 .44 ) . PJUNCOI 3 .44EFO0 13 
1)  EFOOU 

DIMENSION  FCABI 3.51.22) .RCAo I  3 . 51 . 22 ) . P JUNCS ( 3 .44 ) » PCAB ( 3 . 51  *  22 )  EFO015 
DIMENSION  PC A6E(3. 51.22) .PC ABO (3.51.22) .RCABOI3. 51.22)  EFOOU 

DIMENSION  NMODE122) .ERJUNC ( 44 ) • I R JUNC 1 44 ) .DATA  1 1 0 ) .DATN(IO) »H(22)  EF0017 


DIMENSION  P JUNC (3* 44)  .CDCAU ( 22 ) .DCABI22) »ANJUMC<44) .TEST (14) 
DIMENSION  ZVEL ( 25 )  .VELZ(25)  .LC I  CAB (22) »EXpCAb(22) .2JUNC122) 
DIMENSION  L JUNC ( 22 ) .PATH ( 22 ) » 1 C AB ( 22 ) .WCABI22 ) « I  DEVI  1000) 
DIMENSION  I  CHECK ( 44 ) 

DIMENSION  WTEL ( 3 ) .VNORMJ3) .PSPACE<3) 

INTEGER  OUTAPE .Z JUNC .ERJUNC .AN JUNC .OFLG 
INTEGER  PATH 
REAL  IR.IRS 

CALCULATE  THE  WEIGHT  VECTOR  OF  A  DEVICE 

WTEL ( 1 ) =0 • 

WTEL ( 2 ) =0* 

WTEL ( 3 ) =DAT  A ( 6 ) 

CHECK.  TO  btt  IF  CURRENT  OR  NO  CURRENT 

JUM= JUMP+1 
GO  TO ( 1 .2) . JUM 

GET  HERE  IF  NO  CURRENT 

1  EFORCE  =  WTEL( I ) 

RETURN 

GET  HERE  IF  CURRENT 

CALCULATE  LOCATION  OF  DEVICE  IN  SPACE 

2  DO  3  KK=1.3 
K»KK 

3  PSPACE ( K ) = SPACE ( K )  , 


CHECK  IF  DEVICE  IS  IN-LINE  OR  FREE 

IJMP=OATA(4) 

GO  TO  (5.4. 5. 4). I JMP 


GET  HERE 


FREE  TYPE  DEVICE  —  CALCULATE  MAGNITUDE  OF  THE  CURRENT 


►  VMAG=SORT (VELOC ( 1 .PSPACE ) **2 

1 ) **2  ) 


VELGC(2»PSPACE)**2 


TEST  ( 1  4  )  EFOOU 

JNC122)  EF0019 

1000)  EF0020 

EF0021 
EFO022 
EF0023 
EFO024 
EF002S 
EFO026 
EF0027 
EF0028 
EF0029 
EF0030 
EF0031 
EF0032 
EF0033 
EF0034 
EF0035 
EF0036 
EF0037 
EF0038 
EF0039 
EF0040 
EF0041 
EF0042 
EF0043 
EFO044 
EFO045 
EFO046 
EFO047 
EF0048 
EFO049 
EF0050 
EFO051 
EFO052 
EF0053 
EFO054 

HE  CURRENT  EFO055 
EF0056 

VELOCI3.PSPACEEF0057 

EFO058 

EFO059 


r.  t. 

■  ■ 

c  ■%'*  v  y 

c  »  - 1  -M 

cl  " 

c 

c 

C  -  .  -v’./ 

v<>AT'A< 
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C  CALCULATE  THE  FORCE  ON  THE  FREE  DEVICE 
C 

EFORCt  =  WTEL(  I  )  +  <  RHO/2  •  )  *DmTA<  7  )*0AT  A(  8  )  *VMAG*VELOC  (  I  >PSPACE  ) 
RETURN 
C 

C  OET  HERE  IF  IN-LINE  DEVICE 

C  CALCULATE  THE  TANGENTIAL  PROJECTION  OF  THE  CURRENT  ON  THE  DEVICE 
TANG(I)  EVALUATES  THE  UNIT  TANGENT  TO  A  CABLE  AT  ANY  POINT 

5  VPROJ=0. 

DO  6  KK=1»3 

6  VPROJ  =  VPROJ  +  VELOC ( K * PS PACE ) *  T ANG ( < I 
C 

C  CALCULATE  THE  NORMAL  COMPONENT  OF  THE  CURRENT  AND  ITS  MAGNITUDE 
C 

DO  7  KK.  =  1,3 
K'KK 

7  VNORM  (K.)=VELOC(K.»PSPACE)  -VPKUJ*  TANG  ( K  I 
VNMAG=SORT ( VNORMI 1 ) »*2  +  VNORM(2J**2  +  VNOIM  ( 3) **2 ) 

C 

C  CALCULATE  THE  FORCE  ON  THE  IN-LINE  DEVICE 
C 

EFORCE  =  WTEL ( I )  +  (RHO/2 . I* DAT A ( 7 ) *  I  DATA ( 8  1/12.) *DATA t  9 ) * VMM AG 
1  * VNORM (I) 

RETURN 

END 


EF0060 

EF0061 

EF0062 

EF0063 

EF0064 

EF006S 

EF0066 

EFO067 

EFO068 

EF006V 

EF0070 

EF0071 

EF0072 

EF0073 

EF0074 

EF0075 

EFO076 

EF0077 

EF0078 

EF0079 

EFOOBO 

EF0081 

EF0082 

EF0083 

EF0084 

EF008S 

EFOQ86 
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R.A.  SKOP  AND  J.  MARK 


FUNCTION  CFORCE  (I#M#N)  CF0001 

CFO002 

ROUTINE  CALCULATES  THt  FORCt/LENGTH  IN  DIRECTION  I  AT  NODE  M  CF0003 

ABLE  N  USING  THE  NORMAL  DRAG  FORCE  APPROXIMATION  CF0004 

CF0005 

COMMON  /Bl/  Ft JUNC  » I R .UtLTA 1 .DELT A  .  1 RS » TF JUNC  »E *ES » FCAB .RCAB * JUMP >CF0006 


THIS  ROUTINE  CALCULATES  THt  FORCt/LLNGTH  IN  DIRECTION 
ON  CABLE  N  USING  THE  NORMAL  DRAG  FORCE  APPROXIMATION 


1PJUNCS  »PCA8 ♦ PC A BE  tPCABO  »RCABO*THETA  *P JUNCO 
COMMON  /B2/  NCAB  .NNODE  *ER JUNC  . IRJUNC.DATA  .DATN  *H  *P JUNC  * 


CF0007 

CF0008 


1C0CAB*DCAB» FATE »NANC  *ANJUNC*I READ  * 1PRNT  »  INTAPE  *OUT APE  *  I T 1  ME  » I FLG *  CF0009 
20FLG.NIK.THETAS*  THtT  AE  .COMPu  .  THtT  Aa  »N JUNC  *RHO  *  T  EST .  CFOOlC 

3NVSEG.ZVEL.VELZ  *PIP*ECICAB»tXPCAB»2JUNC  *L JUNC  *  PATH  * ICAB*IVOPT  *  CFOOU 
4WCA8  »  I  DEV  *  I  CHECK.  *NDEV  *NDATC  CF0012 

DIMENSION  FE JUNC  <  3  *44 ) »IRl 3 *44) . I  RSI  3  *44)  » T F JUNC I  3  * 44 ) *P JUNCO ( 3 *44CF0013 
1)  CF0014 

DIMENSION  FCAB I  3 *5 1.22  I ♦ RCABI 3 . 5 1  *  22 ) *P JUNCS I  3 *44 ) *  PC AB ( 3 . 51 *22 )  CFO015 
DIMENSION  PCABt(3. 51. 22) .PCAB0I3. 51.22) .RCABOI3. 51*22)  CF0016 

DIMENSION  NNODEI22 ) *  ER JUNC ( 44 ) . IR JUNC 144) *DATA ( 10 ) *DATN ( 10 ) .HI  22 )  CF0017 


DIMENSION  P JUNC l 3.  44) *CDCAB I  22 ) .DC Ad  I  22)  .  ANJUNC I  44 ) .TEST  I  14) 
DIMENSION  ZVEL (25)  .VELZI 25 ) .EC  I  CAB (22 ) .EXPCAB (22 ) . 2 JUNC (22 ) 
DIMENSION  L JUNC (22)  .PATH! 22) . I C AB ( 2 2 )  . WC AB ( 22 ) *  I  DEV ( 1000) 
DIMENSION  I  CHECK ( 44 ) 

DIMENSION  WTCAB ( 3 )  .VNORM(3) .PSPACE(3) 

INTEGER  OU TAPE  «Z JUNC  *LR JUNC. AN JUNC *CFLG 
INTEGER  PATH 
REAL  IK. IRS 

CALCULATE  THE  WE IGHT/LtNGTH  VtCTOR 

WTCABI 1 )=0. 
wTCAb ( 2 ) =0 . 

WTCAB(3)=WCAB(N) 

CHECK  TO  StE  IF  CURRENT  OR  NO  CURRtNT 

JUM- JUMP+1 
GO  TO  (1.2) .JUM 

GET  HERE  IF  NO  CURRENT 

1  CFOKCt=WTCAB( 1 ) 

RETURN 

GET  HERE  IF  CURRENT 

CALCULATE  LOCATION  OF  MODE  IN  SPACE 

2  DO  3  K  =  1  *  3 

3  PSPACE ( K ) -PCAB ( K .M  *N ) 

CALCULATE  THE  TANGENTIAL  PROJECTION  OF  THt  CURRENT  ON  THE  CABLE 


VPROJ  =  0 • 

DO  4  K.K  =  1*3 
K  =  KK 

4  VPROJ= VPROJ 


VELOC(K.PSPACt) 


RCAb(K.M.N) 


TCAB(M.N) 


CALCULATE  THt  NORMAL  COMPONENT  OF  THE  CURRENT  AMD  ITS  MAGNITUDE 
DO  5  KK “1.3 


CF0018 

CF0019 

CF0020 

CFO021 

CF0022 

CF0023 

CF0024 

CFO025 

CFO026 

CFO027 

CF0028 

CFO029 

CFO030 

CFO031 

CFO032 

CF0033 

CF0034 

CFO035 

CFO036 

CF0037 

CF0038 

CFO039 

CFO040 

CF  004 1 

CF0042 

CF0043 

CF0044 

CF0045 

CFO046 

CFO047 

CF0048 

CF004V 

CF0050 

CF0051 

CF0052 

CFO053 

CF0054 

CF0055 

CF0056 

CFO057 

CF  005  8 
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5  VNORM ( K  )  =  VELOCIK.PSPACE )  -  VPROJ  *  KCAB ( K »M .N )  /  T  C  A  b  l  M  » N )  CF0060 

VNMAG  =  SQR  T  <  VNORM  (  1  )  **2  +  VNORM!  2  )  **2  +  VNOKK <  3  )  * # 2  )  CFO061 

C  CFO062 

C  CALCULATE  THE  FORCL/LENGTh  CF0063 

C  C  F  0064 

CFORCt=WTCAb  (  I  l  +  IRMO/2.  )  *CLCAb  ( N )  *  (  DC  Ab  ( N  )  / 1 2  .  )  *LXC  AB  CM  »N)  *VNMAG  CF0065 
1  *VNORM ( 1 )  CFO066 

RETURN  CF0067 

END  CFU06S 


FUNCTION  SPACE (I)  SPA001 

SPA002 

THIS  ROUTINE  CALCULATES  THE  LOCATION  IN  SPACE  SPA003 

OF  ANY  POINT  ON  THE  ARRAY  SPA004 

SPAOOS 

COMMON  /bl/  FEJUNC  .IR.DElTaI.DELTA.1 RS.TFJUNC  »E  *LS * FCAB * RCAb  » JUMP .SPA006 
1PJUNCS  *PCAb  *  PC  ABE  .PCAoO  »  RCAL50  »  TmETA  .PJUNC0  SPA007 

COMMON  /U2/  NCAU.NNODE.ERJUNC.IKJUNC.DATA.DATN.H.PJUNC.  SPAOOS 

ICDCAtJ.DCAB.FATE ,NANC  tANJUNC » I  READ* I PRNT *  INTAPE »OUT APE  « I T 1 ME  » I FLG *  SPAOOV 
20FLG.MR*  THETAS.  THE  TAE  .COMPO  »  THL  T  Ab  *N  JUNC  »RHC  .TEST  .  SPAOlO 

3NVSEG.iVEL.VELZ.PIP » EC  1 C Ao  ,EXPC Ab . Z JUNC iLJUNC.PATh. 1CAB.1V0PT .  SPAOll 
4WCAB  ,  I  l)LV  .  I  CftECK.NULV. NO  A  TC  SPA012 

DIMENSION  FEJUNC (3.44) . I R ( 3 .44 J . I RS I  3 .44 1  ,  TF JUNC ( 3 » 44 )  . P JUNCO I  3 . 44SPA0 1 3 
1)  SPA014 

DIMENSION  FCA0<3.51  .22) . RCAb ( 3  .  S 1 . 22 )  . P JUNCS ( 3 .44 ) .PCAB13.S1 .22)  SPA01S 
DIMENSION  PCABK3.51  .22)  . PCAbO ( 3 . 5 1 . 2 2 ) . RC ABO ( 3 . 5 1 . 2 2 )  SPA016 


DIMENSION  NNODE ( 22 )  .ER JUNC (44)  , I R JUNC (44 )  .DATAt 10)  *DATN( 10)  .Ht  22 )  SPA017 
DIMENSION  P JUNC (3.44 )  .CDCAtM  22 ) .DCAB( 22 ) .ANJUNC(44 )  .TEST l 14) 

DIMENSION  Z VtL ( 25 )  .VCLZ(25)  »eC1CAB<22) »EXPCAd<22) . Z JUNC ( 2 2 ) 

DIMENSION  E  JUNC  (  22)  .  PATH  (  22  )  »  ICAo  (  22  )  .V.'CAB  (  22  )  *  I  DEV  (1000  ) 

DIMENSION  I  CHECK (44) 

INTEOER  OUTAPE .ZJUNC  .EH JUNC  .AN JUNC  .OFLG 
INTEGER  PATH 
REAL  IR.IRS 

IF (DATAI2 ) .EQ.TLSTt 3) )  GO  TO  1 
IF(DATA(2) .E0.TLSTI4) )  GO  TO  2 
C 

C  GET  HERE  IE  JUNCTION  POINT 
C 

1  K  =  D  A  T  A  (  3  ) 

SPACE  =  PJUNC ( I »  K ) 

RETURN 

C 

C  GET  HERE  IE  POINT  ON  A  CABLE 
C 

2  N=DATA<3) 

M=  (DATA ( 10) /H(N ) )  +1 
C 

C  CALCULATE  DISTANCE.  SIGMA.  OF  POINT  FROM  NOOt.  M 
C 

SIGMA  =  DAT  A (10)  -  (M-1I*H(N) 

C 

c  calculate  extrapolation  QUANTITIES 
c 

EM  =  EXC  Ab  ( K  »N  )  *RC Au (  I  ,y,,f. )  / T C A t)  ( M  > N  ) 

EMI  -  EXCAB  (M+ 1  »N)*RCA!t(  I  .M+l  .N)  /TCAB(M+1  ,N) 

C 

C  CALCULATE  LOCATION 
C 

SPACE  «  PCAB (  I  »M  »N  )  +  LEU'S  I  &MA+  1  ( l  M 1 -EM  )  /H  ( N  )  )  »  (  S I GMA* ►  2  )  /2  . 

RETURN 


SPA018 
SPA019 
SPA020 
SPA021 
SPA022 
SPA023 
SPA0Z4 
SPA025 
SPA026 
SPA027 
SPA02S 
SPA029 
SPA030 
SPA03 1 
SPA032 
SPA033 
SPA034 
SP AO  3  5 
SPA036 
SPA037 
SPA038 
SPA03V 
SPA040 
5PA041 
SPA042 
SPA043 
SPA044 
SPA04S 
S  P  A  0  4  6 
SPA  04  7 
SPA04S 
SPA049 
SPA050 
S  P  A  0  5  1 
SPA052 


n  n  r\  n 
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FUNCTION  VELOC  < I * PS PACE ) 


THIS  ROUTINE  SPECIFIES  THE  I  COMPONENT  OF 
AT  AN  ARBITRARY  POINT  IN  SPACE.  PSPACEII) 


THE  CURRENT  FIELD 


VEL001 
VEL002 
VEL003 
VEL004 
VEL005 

COMMON  /bl/  FEJUNC. IR.OtLTAl .OLLTA  .IRS.TFJUNC  .£ »£S .FCAb »RCAU * JUMP .VEL006 
IP JUNCS . PCAB  * PCAbE .  PC AuO  t  RC AbO . T ME T A  *P JUNCO  VEL007 

COMMON  /62/  NCAb .NNODE . tRJUi.C . I KJUNC . DATA .DATn  »H .P JUNC  »  VEL008 

ICOCAb .DCAB.FATL  »NANC .AN JUNC  *  I Kl  AD . 1PRNT  » 1  NT  APE .OUT APE . I T I  ME . IFLG .  VEL009 
20FLG.NI R» THETAS. THE TAE.COMPD* The TAll.N JUNC  .RHO.TEST t  VEL010 

3NVSEG.2VEL.VELZ.PIP . EC ICAb  .  tXPCAb .2 JUNC  .LJUNC .PATH* I  CAB  » IVOPT.  VEL011 

4WC  Ab  .  I  DEV . I  CHECK .NDEV.NDATC  VEL0X2 

DIMENSION  FEJUNC (3.4 A) . I R I  3  .44 ) . I RS ( 3 .44  )  . TF JUNC ( 3  * 44 )  .PJUNC0(3 .44VEL013 
1)  VEL014 

DIMENSION  FCAB  (3.51*22)  .  RC AB l 3 . 51 . 22 )  »P  JUNCS  (  3 .44  )  .PCAB  (3. 51  .22) 
DIMENSION  PCABE (3 .51.2 2  I  .PC ABO ( 3 . 5 1 . 22 ) .RCAbOt 3 .51 .22 ) 

DIMENSION  NNODb ( 22 )  .ERJUNC (44 ) .IRJUMC(44) .DATA  1 10 ) .DATN  1 10 ) »H(22) 
DIMENSION  P JUNC (3. 44) .COCAB (22 ) »DCAB( 22 ) .AN JUNC ( 44 ) .TEST ( 14) 

DIMENSION  ZVtL  <  25 ) .VELZ(25 ) .EC  I  CAB ( 22 ) . EXPCAB (22) .2 JUNC (22 ) 

DIMENSION  LJUNC (22) ,PATH(22).1CAB(22) .UCABI22) . I  DEV ( 1000) 

DIMENSION  I  CHECK ( 44 ) 

DIMENSION  PSPACE ( 3 ) 

INTEGER  OUTAPE .Z JUNC .ERJUNC. AN JUNC .OFLG 


10 


11 


12 


13 


14 

21 

22 

30 


INTEGER  PATH 
REAL  1R» IRS 
GO  TO  ( 10.10.30 ) . I 
Z=PSPACE(3) 

DO  11  KK=1»NVSEG 
K  =  KK 

IF(2.GT.2VEL(K) )  GO  TO  11 

GO  TO  12 

CONTINUE 

VFPS=(1.6878)*VELZ(K.) 

GO  TO  14 

IF(K.NE.l)  GO  TO  13 
VFPS=(1.6878I*VELZ(K) 

GO  TO  14 

SIGMA=Z-ZVEL<K~1) 

SLOPE = (VELZ(K)-VELZ(K-l ) ) / ( ZVEL ( K ) -2V EL ( K- 1 ) ) 
VFPS= ( 1.6878 )*( VELZ ( K—l ) +SLOPE*SI GMA ) 

GO  TO  (21.22) .1 

VELOC  =  VFPS*COS ( THE  TA*PI P ) 

RETURN 

VELOC=VFPS*SIN ( THETA»PIP ) 

RETURN 

VEL0C=0. 

RETURN 

END 


VEL015 
VEL016 
VEL017 
VEL018 
VELO 1 9 
VEL020 
VEL021 
VEL022 
VEL023 
VEL024 
VEL025 
VEL026 
VEL027 
VEL028 
VEL029 
VEL030 
VEL031 
VEL032 
VEL033 
VEL034 
VEL035 
VEL036 
VEL037 
VEL038 
VEL039 
VEL040 
VEL041 
VEL042 
VEL043 
VEL044 
VEL045 
VEL046 
VEL047 
VEL048 


